#!/usr/bin/perl -w
#
# Project Builder CMS module
# CMS subroutines brought by the the Project-Builder project
# which can be easily used by pbinit scripts
#
# $Id$
#
# Copyright B. Cornec 2007
# Provided under the GPL v2

package ProjectBuilder::CMS;

use strict 'vars';
use Data::Dumper;
use English;
use File::Basename;
use File::Copy;
use POSIX qw(strftime);
use lib qw (lib);
use ProjectBuilder::Base;
use ProjectBuilder::Conf;

# Inherit from the "Exporter" module which handles exporting functions.
 
use Exporter;
 
# Export, by default, all the functions into the namespace of
# any code which uses this module.
 
our @ISA = qw(Exporter);
our @EXPORT = qw(pb_cms_init pb_cms_export pb_cms_get_uri pb_cms_copy pb_cms_checkout pb_cms_up pb_cms_checkin pb_cms_isdiff pb_cms_get_pkg pb_cms_get_real_pkg pb_cms_compliant pb_cms_log pb_cms_add);

=pod

=head1 NAME

ProjectBuilder::CMS, part of the project-builder.org

=head1 DESCRIPTION

This modules provides configuration management system functions suitable for pbinit calls.

=head1 USAGE

=over 4

=item B<pb_cms_init>

This function setup the environment for the CMS system related to the URL given by the pburl configuration parameter.
The potential parameter indicates whether we should inititate the context or not.
It sets up environement variables (PBPROJDIR, PBDIR, PBREVISION, PBCMSLOGFILE) 

=cut

sub pb_cms_init {

my $pbinit = shift || undef;

my ($pburl) = pb_conf_get("pburl");
pb_log(2,"DEBUG: Project URL of $ENV{'PBPROJ'}: $pburl->{$ENV{'PBPROJ'}}\n");
my ($scheme, $account, $host, $port, $path) = pb_get_uri($pburl->{$ENV{'PBPROJ'}});

my ($pbprojdir) = pb_conf_get_if("pbprojdir");

if ((defined $pbprojdir) && (defined $pbprojdir->{$ENV{'PBPROJ'}})) {
	$ENV{'PBPROJDIR'} = $pbprojdir->{$ENV{'PBPROJ'}};
} else {
	$ENV{'PBPROJDIR'} = "$ENV{'PBDEFDIR'}/$ENV{'PBPROJ'}";
}

# Computing the default dir for PBDIR.
# what we have is PBPROJDIR so work from that.
# Tree identical between PBCONFDIR and PBROOTDIR on one side and
# PBPROJDIR and PBDIR on the other side.

my $tmp = $ENV{'PBROOTDIR'};
$tmp =~ s|^$ENV{'PBCONFDIR'}||;

#
# Check project cms compliance
#
pb_cms_compliant(undef,'PBDIR',"$ENV{'PBPROJDIR'}/$tmp",$pburl->{$ENV{'PBPROJ'}},$pbinit);

if ($scheme =~ /^hg/) {
	$tmp = `(cd "$ENV{'PBDIR'}" ; hg identify )`;
	chomp($tmp);
	$tmp =~ s/^.* //;
	$ENV{'PBREVISION'}=$tmp;
	$ENV{'PBCMSLOGFILE'}="hg.log";
} elsif (($scheme eq "file") || ($scheme eq "ftp") || ($scheme eq "http")) {
	$ENV{'PBREVISION'}="flat";
	$ENV{'PBCMSLOGFILE'}="flat.log";
} elsif ($scheme =~ /^svn/) {
	# svnversion more precise than svn info
	$tmp = `(cd "$ENV{'PBDIR'}" ; svnversion .)`;
	chomp($tmp);
	$ENV{'PBREVISION'}=$tmp;
	$ENV{'PBCMSLOGFILE'}="svn.log";
} elsif ($scheme =~ /^cvs/) {
	# Way too slow
	#$ENV{'PBREVISION'}=`(cd "$ENV{'PBROOTDIR'}" ; cvs rannotate  -f . 2>&1 | awk '{print \$1}' | grep -E '^[0-9]' | cut -d. -f2 |sort -nu | tail -1)`;
	#chomp($ENV{'PBREVISION'});
	$ENV{'PBREVISION'}="cvs";
	$ENV{'PBCMSLOGFILE'}="cvs.log";
	$ENV{'CVS_RSH'} = "ssh" if ($scheme =~ /ssh/);
} else {
	die "cms $scheme unknown";
}

return($scheme,$pburl->{$ENV{'PBPROJ'}});
}

=item B<pb_cms_export>

This function exports a CMS content to a directory.
The first parameter is the URL of the CMS content.
The second parameter is the directory in which it is locally exposed (result of a checkout). If undef, then use the original CMS content.
The third parameter is the directory where we want to deliver it (result of export).
It returns the original tar file if we need to preserve it and undef if we use the produced one.

=cut

sub pb_cms_export {

my $uri = shift;
my $source = shift;
my $destdir = shift;
my $tmp;
my $tmp1;

my @date = pb_get_date();
# If it's not flat, then we have a real uri as source
my ($scheme, $account, $host, $port, $path) = pb_get_uri($uri);

if ($scheme =~ /^svn/) {
	if (defined $source) {
		if (-d $source) {
			$tmp = $destdir;
		} else {
			$tmp = "$destdir/".basename($source);
		}
		$source = pb_cms_mod_svn_http($source);
		pb_system("svn export $source $tmp","Exporting $source from SVN to $tmp ");
	} else {
		$uri = pb_cms_mod_svn_http($uri);
		pb_system("svn export $uri $destdir","Exporting $uri from SVN to $destdir ");
	}
} elsif ($scheme eq "dir") {
	pb_system("cp -a $path $destdir","Copying $uri from DIR to $destdir ");
} elsif (($scheme eq "http") || ($scheme eq "ftp")) {
	my $f = basename($path);
	unlink "$ENV{'PBTMP'}/$f";
	if (-x "/usr/bin/wget") {
		pb_system("/usr/bin/wget -nv -O $ENV{'PBTMP'}/$f $uri"," ");
	} elsif (-x "/usr/bin/curl") {
		pb_system("/usr/bin/curl $uri -o $ENV{'PBTMP'}/$f","Downloading $uri with curl to $ENV{'PBTMP'}/$f\n");
	} else {
		die "Unable to download $uri.\nNo wget/curl available, please install one of those";
	}
	# We want to preserve the original tar file
	pb_cms_export("file://$ENV{'PBTMP'}/$f",$source,$destdir);
	return("$ENV{'PBTMP'}/$f");
} elsif ($scheme eq "file") {
	use File::MimeInfo; 
	my $mm = mimetype($path);
	pb_log(2,"mimetype: $mm\n");

	if (defined $source) {
		# Check whether the file is well formed 
		# (containing already a directory with the project-version name)
		#
		# If it's not the case, we try to adapt, but distro needing 
		# to verify the checksum will have issues (Fedora)
		# Then upstream should be notified that they need to change their rules
		my ($pbwf) = pb_conf_get_if("pbwf");
		if ((defined $pbwf) && (defined $pbwf->{$ENV{'PBPROJ'}})) {
			$destdir = dirname($destdir);
		}
	}
	pb_mkdir_p($destdir);

	if ($mm =~ /\/x-bzip-compressed-tar$/) {
		# tar+bzip2
		pb_system("cd $destdir ; tar xfj $path","Extracting $path in $destdir ");
	} elsif ($mm =~ /\/x-lzma-compressed-tar$/) {
		# tar+lzma
		pb_system("cd $destdir ; tar xfY $path","Extracting $path in $destdir ");
	} elsif ($mm =~ /\/x-compressed-tar$/) {
		# tar+gzip
		pb_system("cd $destdir ; tar xfz $path","Extracting $path in $destdir ");
	} elsif ($mm =~ /\/x-tar$/) {
		# tar
		pb_system("cd $destdir ; tar xf $path","Extracting $path in $destdir ");
	} elsif ($mm =~ /\/zip$/) {
		# zip
		pb_system("cd $destdir ; unzip $path","Extracting $path in $destdir ");
	} else {
		# simple file: copy it (patch e.g.)
		copy($path,$destdir);
	}
} elsif ($scheme =~ /^hg/) {
	if (defined $source) {
		if (-d $source) {
			$tmp = $destdir;
		} else {
			$tmp = "$destdir/".basename($source);
		}
		$source = pb_cms_mod_hg_http($source);
		pb_system("cd $source ; hg archive $tmp","Exporting $source from Mercurial to $tmp ");
	} else {
		$uri = pb_cms_mod_hg_http($uri);
		pb_system("hg clone $uri $destdir","Exporting $uri from Mercurial to $destdir ");
	}
} elsif ($scheme =~ /^cvs/) {
	# CVS needs a relative path !
	my $dir=dirname($destdir);
	my $base=basename($destdir);
	if (defined $source) {
		# CVS also needs a modules name not a dir
		$tmp1 = basename($source);
	} else {
		# Probably not right, should be checked, but that way I'll notice it :-)
		$tmp1 = $uri;
	}
	# If we're working on the CVS itself
	my $cvstag = basename($ENV{'PBROOTDIR'});
	my $cvsopt = "";
	if ($cvstag eq "cvs") {
		my $pbdate = strftime("%Y-%m-%d %H:%M:%S", @date);
		$cvsopt = "-D \"$pbdate\"";
	} else {
		# we're working on a tag which should be the last part of PBROOTDIR
		$cvsopt = "-r $cvstag";
	}
	pb_system("cd $dir ; cvs -d $account\@$host:$path export $cvsopt -d $base $tmp1","Exporting $tmp1 from $source under CVS to $destdir ");
} else {
	die "cms $scheme unknown";
}
return(undef);
}

=item B<pb_cms_get_uri>

This function is only called with a real CMS system and gives the URL stored in the checked out directory.
The first parameter is the schema of the CMS systems (svn, cvs, svn+ssh, ...)
The second parameter is the directory in which it is locally exposed (result of a checkout).

=cut

sub pb_cms_get_uri {

my $scheme = shift;
my $dir = shift;

my $res = "";
my $void = "";

if ($scheme =~ /^svn/) {
	open(PIPE,"LANGUAGE=C svn info $dir |") || return("");
	while (<PIPE>) {
		($void,$res) = split(/^URL:/) if (/^URL:/);
	}
	$res =~ s/^\s*//;
	close(PIPE);
	chomp($res);
} elsif ($scheme =~ /^hg/) {
	open(HGRC,".hg/hgrc/") || return("");
	while (<HGRC>) {
		($void,$res) = split(/^default.*=/) if (/^default.*=/);
	}
	close(HGRC);
	chomp($res);
} elsif ($scheme =~ /^cvs/) {
	# This path is always the root path of CVS, but we may be below
	open(FILE,"$dir/CVS/Root") || die "$dir isn't CVS controlled";
	$res = <FILE>;
	chomp($res);
	close(FILE);
	# Find where we are in the tree
	my $rdir = $dir;
	while ((! -d "$rdir/CVSROOT") && ($rdir ne "/")) {
		$rdir = dirname($rdir);
	}
	die "Unable to find a CVSROOT dir in the parents of $dir" if (! -d "$rdir/CVSROOT");
	#compute our place under that root dir - should be a relative path
	$dir =~ s|^$rdir||;
	my $suffix = "";
	$suffix = "$dir" if ($dir ne "");

	my $prefix = "";
	if ($scheme =~ /ssh/) {
		$prefix = "cvs+ssh://";
	} else {
		$prefix = "cvs://";
	}
	$res = $prefix.$res.$suffix;
} else {
	die "cms $scheme unknown";
}
pb_log(2,"Found CMS info: $res\n");
return($res);
}

=item B<pb_cms_copy>

This function copies a CMS content to another.
The first parameter is the schema of the CMS systems (svn, cvs, svn+ssh, ...)
The second parameter is the URL of the original CMS content.
The third parameter is the URL of the destination CMS content.

Only coded for SVN now as used for pbconf itself not the project

=cut

sub pb_cms_copy {
my $scheme = shift;
my $oldurl = shift;
my $newurl = shift;

if ($scheme =~ /^svn/) {
	$oldurl = pb_cms_mod_svn_http($oldurl);
	$newurl = pb_cms_mod_svn_http($newurl);
	pb_system("svn copy -m \"Creation of $newurl from $oldurl\" $oldurl $newurl","Copying $oldurl to $newurl ");
} elsif ($scheme eq "flat") {
} elsif ($scheme =~ /^cvs/) {
} else {
	die "cms $scheme unknown";
}
}

=item B<pb_cms_checkout>

This function checks a CMS content out to a directory.
The first parameter is the schema of the CMS systems (svn, cvs, svn+ssh, ...)
The second parameter is the URL of the CMS content.
The third parameter is the directory where we want to deliver it (result of export).

=cut

sub pb_cms_checkout {
my $scheme = shift;
my $url = shift;
my $destination = shift;

if ($scheme =~ /^svn/) {
	$url = pb_cms_mod_svn_http($url);
	pb_system("svn co $url $destination","Checking out $url to $destination ");
} elsif ($scheme =~ /^hg/) {
	$url = pb_cms_mod_hg_http($url);
	pb_system("hg clone $url $destination","Checking out $url to $destination ");
} elsif (($scheme eq "ftp") || ($scheme eq "http")) {
	return;
} elsif ($scheme =~ /^cvs/) {
	my ($scheme, $account, $host, $port, $path) = pb_get_uri($url);

	# If we're working on the CVS itself
	my $cvstag = basename($ENV{'PBROOTDIR'});
	my $cvsopt = "";
	if ($cvstag eq "cvs") {
		my @date = pb_get_date();
		my $pbdate = strftime("%Y-%m-%d %H:%M:%S", @date);
		$cvsopt = "-D \"$pbdate\"";
	} else {
		# we're working on a tag which should be the last part of PBROOTDIR
		$cvsopt = "-r $cvstag";
	}
	pb_mkdir_p("$destination");
	pb_system("cd $destination ; cvs -d $account\@$host:$path co $cvsopt .","Checking out $url to $destination ");
} elsif ($scheme =~ /^file/) {
	pb_cms_export($url,undef,$destination);
} else {
	die "cms $scheme unknown";
}
}

=item B<pb_cms_up>

This function updates a local directory with the CMS content.
The first parameter is the schema of the CMS systems (svn, cvs, svn+ssh, ...)
The second parameter is the directory to update.

=cut

sub pb_cms_up {
my $scheme = shift;
my $dir = shift;

if ($scheme =~ /^svn/) {
	pb_system("svn up $dir","Updating $dir ");
} elsif ($scheme eq "flat") {
} elsif ($scheme =~ /^hg/) {
	pb_system("cd $dir ; hg up","Updating $dir ");
} elsif ($scheme =~ /^cvs/) {
	pb_system("cvs up $dir","Updating $dir ");
} else {
	die "cms $scheme unknown";
}
}

=item B<pb_cms_checkin>

This function updates a CMS content from a local directory.
The first parameter is the schema of the CMS systems (svn, cvs, svn+ssh, ...)
The second parameter is the directory to update from.
The third parameter indicates if we are in a new version creation (undef) or in a new project creation (1)

=cut

sub pb_cms_checkin {
my $scheme = shift;
my $dir = shift;
my $pbinit = shift || undef;

my $ver = basename($dir);
my $msg = "updated to $ver";
$msg = "Project $ENV{PBPROJ} creation" if (defined $pbinit);

if ($scheme =~ /^svn/) {
	pb_system("svn ci -m \"$msg\" $dir","Checking in $dir ");
} elsif ($scheme eq "flat") {
} elsif ($scheme =~ /^hg/) {
	pb_system("cd $dir ; hg ci -m \"$msg\" .","Checking in $dir ");
} elsif ($scheme =~ /^cvs/) {
	pb_system("cvs ci -m \"$msg\" $dir","Checking in $dir ");
} else {
	die "cms $scheme unknown";
}
pb_cms_up($scheme,$dir);
}

=item B<pb_cms_add>

This function adds to a CMS content from a local directory.
The first parameter is the schema of the CMS systems (svn, cvs, svn+ssh, ...)
The second parameter is the directory/file to add.

=cut

sub pb_cms_add {
my $scheme = shift;
my $f = shift;

if ($scheme =~ /^svn/) {
	pb_system("svn add $f","Adding $f to SVN ");
} elsif ($scheme eq "flat") {
} elsif ($scheme =~ /^hg/) {
	pb_system("hg add $f","Adding $f to Mercurial ");
} elsif ($scheme =~ /^cvs/) {
	pb_system("cvs add $f","Adding $f to CVS ");
} else {
	die "cms $scheme unknown";
}
pb_cms_up($scheme,$f);
}

=item B<pb_cms_isdiff>

This function returns a integer indicating the number f differences between the CMS content and the local directory where it's checked out.
The first parameter is the schema of the CMS systems (svn, cvs, svn+ssh, ...)
The second parameter is the directory to consider.

=cut

sub pb_cms_isdiff {
my $scheme = shift;
my $dir =shift;

if ($scheme =~ /^svn/) {
	open(PIPE,"svn diff $dir |") || die "Unable to get svn diff from $dir";
	my $l = 0;
	while (<PIPE>) {
		$l++;
	}
	return($l);
} elsif ($scheme =~ /^hg/) {
	open(PIPE,"hg diff $dir |") || die "Unable to get hg diff from $dir";
	my $l = 0;
	while (<PIPE>) {
		$l++;
	}
	return($l);
} elsif ($scheme eq "flat") {
} elsif ($scheme =~ /^cvs/) {
	open(PIPE,"cvs diff $dir |") || die "Unable to get svn diff from $dir";
	my $l = 0;
	while (<PIPE>) {
		# Skipping normal messages
		next if (/^cvs diff:/);
		$l++;
	}
	return($l);
} else {
	die "cms $scheme unknown";
}
}

=item B<pb_cms_get_pkg>

This function returns the list of packages we are working on in a CMS action.
The first parameter is the default list of packages from the configuration file.
The second parameter is the optional list of packages from the configuration file.

=cut

sub pb_cms_get_pkg {

my @pkgs = ();
my $defpkgdir = shift || undef;
my $extpkgdir = shift || undef;

# Get packages list
if (not defined $ARGV[0]) {
	@pkgs = keys %$defpkgdir if (defined $defpkgdir);
} elsif ($ARGV[0] =~ /^all$/) {
	@pkgs = keys %$defpkgdir if (defined $defpkgdir);
	push(@pkgs, keys %$extpkgdir) if (defined $extpkgdir);
} else {
	@pkgs = @ARGV;
}
pb_log(0,"Packages: ".join(',',@pkgs)."\n");
return(\@pkgs);
}

=item B<pb_cms_get_real_pkg>

This function returns the real name of a virtual package we are working on in a CMS action.
It supports the following types: perl.
The first parameter is the virtual package name

=cut

sub pb_cms_get_real_pkg {

my $pbpkg = shift || undef;
my $dtype = shift;
my $pbpkgreal = $pbpkg;

my @nametype = pb_conf_get_if("namingtype");
my $type = $nametype[0]->{$pbpkg};
if (defined $type) {
	if ($type eq "perl") {
		if ($dtype eq "rpm") {
			$pbpkgreal = "perl-".$pbpkg;
		} elsif ($dtype eq "deb") {
			# Only lower case allowed in Debian
			# Cf: http://www.debian.org/doc/debian-policy/ch-controlfields.html#s-f-Package
			$pbpkgreal = "lib".lc($pbpkg)."-perl";
		} elsif ($dtype eq "ebuild") {
			$pbpkgreal = $pbpkg;
		} else {
			die "pb_cms_get_real_pkg not implemented for $dtype yet";
		}
	} else {
		die "nametype $type not implemented yet";
	}
}

pb_log(2,"Real Package: $pbpkgreal\n");
return($pbpkgreal);
}

=item B<pb_cms_compliant>

This function checks the compliance of the project and the pbconf directory.
The first parameter is the key name of the value that needs to be read in the configuration file.
The second parameter is the environment variable this key will populate.
The third parameter is the location of the pbconf dir.
The fourth parameter is the URI of the CMS content related to the pbconf dir.
The fifth parameter indicates whether we should inititate the context or not.

=cut

sub pb_cms_compliant {

my $param = shift;
my $envar = shift;
my $defdir = shift;
my $uri = shift;
my $pbinit = shift;
my %pdir;

my ($pdir) = pb_conf_get_if($param) if (defined $param);
if (defined $pdir) {
	%pdir = %$pdir;
}


if ((defined $pdir) && (%pdir) && (defined $pdir{$ENV{'PBPROJ'}})) {
	# That's always the environment variable that will be used
	$ENV{$envar} = $pdir{$ENV{'PBPROJ'}};
} else {
	if (defined $param) {
		pb_log(1,"WARNING: no $param defined, using $defdir\n");
		pb_log(1,"         Please create a $param reference for project $ENV{'PBPROJ'} in $ENV{'PBETC'}\n");
		pb_log(1,"         if you want to use another directory\n");
	}
	$ENV{$envar} = "$defdir";
}

# Expand potential env variable in it
eval { $ENV{$envar} =~ s/(\$ENV.+\})/$1/eeg };
pb_log(2,"$envar: $ENV{$envar}\n");

my ($scheme, $account, $host, $port, $path) = pb_get_uri($uri);

if ((! -d "$ENV{$envar}") || (defined $pbinit)) {
	if (defined $pbinit) {
		pb_mkdir_p("$ENV{$envar}");
	} else {
		pb_log(1,"Checking out $uri\n");
		pb_cms_checkout($scheme,$uri,$ENV{$envar});
	}
} elsif (($scheme !~ /^cvs/) || ($scheme !~ /^svn/)  || ($scheme !~ /^hg/)) {
	# Do not compare if it's not a real cms
	return;
} else {
	pb_log(1,"$uri found locally, checking content\n");
	my $cmsurl = pb_cms_get_uri($scheme,$ENV{$envar});
	my ($scheme2, $account2, $host2, $port2, $path2) = pb_get_uri($cmsurl);
	if ($cmsurl ne $uri) {
		# The local content doesn't correpond to the repository
		pb_log(0,"ERROR: Inconsistency detected:\n");
		pb_log(0,"       * $ENV{$envar} refers to $cmsurl but\n");
		pb_log(0,"       * $ENV{'PBETC'} refers to $uri\n");
		die "Project $ENV{'PBPROJ'} is not Project-Builder compliant.";
	} else {
		pb_log(1,"Content correct - doing nothing - you may want to update your repository however\n");
		# they match - do nothing - there may be local changes
	}
}
}

=item B<pb_cms_create_authors>

This function creates a AUTHORS files for the project. It call it AUTHORS.pb if an AUTHORS file already exists.
The first parameter is the source file for authors information.
The second parameter is the directory where to create the final AUTHORS file.
The third parameter is the schema of the CMS systems (svn, cvs, svn+ssh, ...)

=cut

sub pb_cms_create_authors {

my $authors=shift;
my $dest=shift;
my $scheme=shift;

return if ($authors eq "/dev/null");
open(SAUTH,$authors) || die "Unable to open $authors";
# Save a potentially existing AUTHORS file and write instead to AUTHORS.pb 
my $ext = "";
if (-f "$dest/AUTHORS") {
	$ext = ".pb";
}
open(DAUTH,"> $dest/AUTHORS$ext") || die "Unable to create $dest/AUTHORS$ext";
print DAUTH "Authors of the project are:\n";
print DAUTH "===========================\n";
while (<SAUTH>) {
	my ($nick,$gcos) = split(/:/);
	chomp($gcos);
	print DAUTH "$gcos";
	if (defined $scheme) {
		# Do not give a scheme for flat types
		my $endstr="";
		if ("$ENV{'PBREVISION'}" ne "flat") {
			$endstr = " under $scheme";
		}
		print DAUTH " ($nick$endstr)\n";
	} else {
		print DAUTH "\n";
	}
}
close(DAUTH);
close(SAUTH);
}

=item B<pb_cms_log>

This function creates a ChangeLog file for the project.
The first parameter is the schema of the CMS systems (svn, cvs, svn+ssh, ...)
The second parameter is the directory where the CMS content was checked out.
The third parameter is the directory where to create the final ChangeLog file.
The fourth parameter is unused.
The fifth parameter is the source file for authors information.

It may use a tool like svn2cl or cvs2cl to generate it if present, or the log file from the CMS if not.

=cut


sub pb_cms_log {

my $scheme = shift;
my $pkgdir = shift;
my $dest = shift;
my $chglog = shift;
my $authors = shift;
my $testver = shift || undef;

pb_cms_create_authors($authors,$dest,$scheme);

if ((defined $testver) && (defined $testver->{$ENV{'PBPROJ'}}) && ($testver->{$ENV{'PBPROJ'}} =~ /true/i)) {
	if (! -f "$dest/ChangeLog") {
		open(CL,"> $dest/ChangeLog") || die "Unable to create $dest/ChangeLog";
		# We need a minimal version for debian type of build
		print CL "\n";
		print CL "\n";
		print CL "\n";
		print CL "\n";
		print CL "1990-01-01  none\n";
		print CL "\n";
		print CL "        * test version\n";
		print CL "\n";
		close(CL);
		pb_log(0,"Generating fake ChangeLog for test version\n");
		open(CL,"> $dest/$ENV{'PBCMSLOGFILE'}") || die "Unable to create $dest/$ENV{'PBCMSLOGFILE'}";
		close(CL);
	}
}

if ($scheme =~ /^svn/) {
	if (! -f "$dest/ChangeLog") {
		# In case we have no network, just create an empty one before to allow correct build
		open(CL,"> $dest/ChangeLog") || die "Unable to create $dest/ChangeLog";
		close(CL);
		if (-x "/usr/bin/svn2cl") {
			pb_system("/usr/bin/svn2cl --group-by-day --authors=$authors -i -o $dest/ChangeLog $pkgdir","Generating ChangeLog from SVN with svn2cl");
		} else {
			# To be written from pbcl
			pb_system("svn log -v $pkgdir > $dest/$ENV{'PBCMSLOGFILE'}","Extracting log info from SVN");
		}
	}
} elsif ($scheme =~ /^hg/) {
	if (! -f "$dest/ChangeLog") {
		# In case we have no network, just create an empty one before to allow correct build
		open(CL,"> $dest/ChangeLog") || die "Unable to create $dest/ChangeLog";
		close(CL);
		pb_system("hg log -v $pkgdir > $dest/$ENV{'PBCMSLOGFILE'}","Extracting log info from SVN");
		}
} elsif (($scheme eq "file") || ($scheme eq "dir") || ($scheme eq "http") || ($scheme eq "ftp")) {
	if (! -f "$dest/ChangeLog") {
		pb_system("echo ChangeLog for $pkgdir > $dest/ChangeLog","Empty ChangeLog file created");
	}
} elsif ($scheme =~ /^cvs/) {
	my $tmp=basename($pkgdir);
	# CVS needs a relative path !
	if (! -f "$dest/ChangeLog") {
		# In case we have no network, just create an empty one before to allow correct build
		open(CL,"> $dest/ChangeLog") || die "Unable to create $dest/ChangeLog";
		close(CL);
		if (-x "/usr/bin/cvs2cl") {
			pb_system("/usr/bin/cvs2cl --group-by-day -U $authors -f $dest/ChangeLog $pkgdir","Generating ChangeLog from CVS with cvs2cl");
		} else {
			# To be written from pbcl
			pb_system("cvs log $tmp > $dest/$ENV{'PBCMSLOGFILE'}","Extracting log info from CVS");
		}
	}
} else {
	die "cms $scheme unknown";
}
}

sub pb_cms_mod_svn_http {

my $url = shift;

$url =~ s/^svn\+(http[s]*):/$1:/;
return($url);
}

sub pb_cms_mod_hg_http {

my $url = shift;

$url =~ s/^hg\+(http[s]*):/$1:/;
return($url);
}

=back 

=head1 WEB SITES

The main Web site of the project is available at L<http://www.project-builder.org/>. Bug reports should be filled using the trac instance of the project at L<http://trac.project-builder.org/>.

=head1 USER MAILING LIST

None exists for the moment.

=head1 AUTHORS

The Project-Builder.org team L<http://trac.project-builder.org/> lead by Bruno Cornec L<mailto:bruno@project-builder.org>.

=head1 COPYRIGHT

Project-Builder.org is distributed under the GPL v2.0 license
described in the file C<COPYING> included with the distribution.

=cut

1;
