#!/usr/bin/perl -w # # Base subroutines for the Project-Builder project # # $Id$ # use strict; use lib qw (lib); use File::Basename; use File::Path; use File::Temp qw /tempdir/; use AppConfig qw(ARGCOUNT_HASH); use Data::Dumper; use ProjectBuilder::Changelog qw (pb_changelog); $ENV{'PBETC'} = "$ENV{'HOME'}/.pbrc"; sub pb_env_init { my $proj=shift; my $ver; my $tag; # For the moment not dynamic my $debug = 0; # Debug level my $LOG = *STDOUT; # Where to log # # Check project name # Could be with env var PBPROJ # or option -p # if not define take the first in conf file # if ((defined $ENV{'PBPROJ'}) && (not (defined $proj))) { $proj = $ENV{'PBPROJ'}; } # # We get the pbrc file for that project # and use its content # my ($pbrc) = pb_conf_read("$ENV{'PBETC'}","pbrc"); print "DEBUG pbrc: ".Dumper($pbrc)."\n" if ($debug >= 1); my %pbrc = %$pbrc; if (not defined $proj) { # Take the first as the default project $proj = (keys %pbrc)[0]; print $LOG "Using $proj as default project as none has been specified\n" if (($debug >= 0) and (defined $proj)); } die "No project defined - use env var PBPROJ or -p proj" if (not (defined $proj)); # # Set delivery directory # my $topdir=dirname($pbrc{$proj}); # Expand potential env variable in it eval { $topdir =~ s/(\$ENV.+\})/$1/eeg }; chdir $topdir || die "Unable to change directory to $topdir"; $pbrc{$proj} = $topdir."/pbrc"; $ENV{'PBDESTDIR'}=$topdir."/delivery"; # # Use project configuration file if needed # if (not defined $ENV{'PBROOT'}) { if (-f $pbrc{$proj}) { my ($pbroot) = pb_conf_read($pbrc{$proj},"pbroot"); my %pbroot = %$pbroot; # All lines should point to the same pbroot so take the first $ENV{'PBROOT'} = (values %$pbroot)[0] if (defined $pbroot); print $LOG "Using $ENV{'PBROOT'} as default pbroot from $pbrc{$proj}\n" if (($debug >= 0) and (defined $ENV{'PBROOT'})); } die "No pbroot defined - use env var PBROOT or -r pbroot " if (not defined $ENV{'PBROOT'}); } # # Check pb conf compliance # $ENV{'PBCONF'} = "$ENV{'PBROOT'}/pbconf"; die "Project $proj not Project-Builder compliant. Please populate $ENV{'PBCONF'}" if ( not -d "$ENV{'PBCONF'}"); my %version = (); my %defpkgdir = (); my %extpkgdir = (); my %filteredfiles = (); if (-f "$ENV{'PBCONF'}/$proj.pb") { # List of pkg to build by default (mandatory) # List of additional pkg to build when all is called (optional) # Valid version names (optional) # List of files to filter (optional) my ($defpkgdir, $extpkgdir, $version, $filteredfiles, $pkgv, $pkgt) = pb_conf_read("$ENV{'PBCONF'}/$proj.pb","defpkgdir","extpkgdir","version","filteredfiles","projver","projtag"); print "DEBUG: defpkgdir: ".Dumper($defpkgdir)."\n" if ($debug >= 1); print "DEBUG: extpkgdir: ".Dumper($extpkgdir)."\n" if ($debug >= 1); print "DEBUG: version: ".Dumper($version)."\n" if ($debug >= 1); print "DEBUG: filteredfiles: ".Dumper($filteredfiles)."\n" if ($debug >= 1); die "Unable to find defpkgdir in $ENV{'PBCONF'}/$proj.pb" if (not defined $defpkgdir); # Global %defpkgdir = %$defpkgdir; # Global %extpkgdir = %$extpkgdir if (defined $extpkgdir); %version = %$version if (defined $version); # Global %filteredfiles = %$filteredfiles if (defined $filteredfiles); # # Get global Version/Tag # if (not defined $ENV{'PBVER'}) { if ((defined $pkgv) && (defined $pkgv->{$proj})) { $ENV{'PBVER'}=$pkgv->{$proj}; } else { die "No projver found in $ENV{'PBCONF'}/$proj.pb"; } } die "Invalid version name $ENV{'PBVER'} in $ENV{'PBCONF'}/$proj.pb" if (($ENV{'PBVER'} !~ /[0-9.]+/) && (not exists $version{$ENV{'PBVER'}})); if (not defined $ENV{'PBTAG'}) { if ((defined $pkgt) && (defined $pkgt->{$proj})) { $ENV{'PBTAG'}=$pkgt->{$proj}; } else { die "No projtag found in $ENV{'PBCONF'}/$proj.pb"; } } die "Invalid tag name $ENV{'PBTAG'} in $ENV{'PBCONF'}/$proj.pb" if ($ENV{'PBTAG'} !~ /[0-9.]+/); } else { die "Unable to open $ENV{'PBCONF'}/$proj.pb"; } # # Set temp directory # if (not defined $ENV{'TMPDIR'}) { $ENV{'TMPDIR'}="/tmp"; } $ENV{'PBTMP'} = tempdir( "pb.XXXXXXXXXX", DIR => $ENV{'TMPDIR'}, CLEANUP => 1 ); # # Removes all directory existing below the delivery dir # as they are temp dir only # Files stay and have to be cleaned up manually # if (-d $ENV{'PBDESTDIR'}) { opendir(DIR,$ENV{'PBDESTDIR'}) || die "Unable to open directory $ENV{'PBDESTDIR'}: $!"; foreach my $d (readdir(DIR)) { next if ($d =~ /^\./); next if (-f "$ENV{'PBDESTDIR'}/$d"); pb_rm_rf("$ENV{'PBDESTDIR'}/$d") if (-d "$ENV{'PBDESTDIR'}/$d"); } closedir(DIR); } if (! -d "$ENV{'PBDESTDIR'}") { pb_mkdir_p($ENV{'PBDESTDIR'}) || die "Unable to recursively create $ENV{'PBDESTDIR'}"; } # # Set build directory # $ENV{'PBBUILDDIR'}=$topdir."/build"; if (! -d "$ENV{'PBBUILDDIR'}") { pb_mkdir_p($ENV{'PBBUILDDIR'}) || die "Unable to recursively create $ENV{'PBBUILDDIR'}"; } umask 0022; return($proj,$debug,$LOG,\%pbrc, \%filteredfiles, \%defpkgdir, \%extpkgdir); } # Internal mkdir -p function sub pb_mkdir_p { my @dir = @_; my $ret = mkpath(@dir, 0, 0755); return($ret); } # Internal rm -rf function sub pb_rm_rf { my @dir = @_; my $ret = rmtree(@dir, 0, 0); return($ret); } # Internal system function sub pb_system { my $cmd=shift; my $cmt=shift || $cmd; print "$cmt... "; #system("$cmd 2>&1 > $ENV{'PBTMP'}/system.log"); system("$cmd"); if ($? == -1) { print "failed to execute ($cmd) : $!\n"; pb_display_file("$ENV{'PBTMP'}/system.log"); } elsif ($? & 127) { printf "child ($cmd) died with signal %d, %s coredump\n", ($? & 127), ($? & 128) ? 'with' : 'without'; pb_display_file("$ENV{'PBTMP'}/system.log"); } elsif ($? == 0) { print "OK\n"; } else { printf "child ($cmd) exited with value %d\n", $? >> 8; pb_display_file("$ENV{'PBTMP'}/system.log"); } } sub pb_display_file { my $file=shift; return if (not -f $file); open(FILE,"$file"); while () { print $_; } close(FILE); } # Function which returns a pointer on a table # corresponding to a set of values queried in the conf file # and test the returned vaue as they need to exist in that case sub pb_conf_get { my @param = @_; # Everything is returned via ptr1 my @ptr1 = pb_conf_read("$ENV{'PBETC'}", @param); my @ptr2 = pb_conf_read("$ENV{'PBCONF'}/$ENV{'PBPROJ'}.pb", @param); my $p1; my $p2; foreach my $i (0..$#param) { die "No $param[$i] defined for $ENV{'PBPROJ'}" if ((not defined $ptr1[$i]) && (not defined $ptr2[$i])); # Always try to take the param from the home dir conf file in priority # in order to mask what could be defined under the CMS to allow for overloading $p1 = $ptr1[$i]; $p2 = $ptr2[$i]; if (not defined $p2) { # No ref in CMS project conf file so use the home dir one. $p1->{$ENV{'PBPROJ'}} = $p1->{'default'} if (not defined $p1->{$ENV{'PBPROJ'}}); } else { # Ref found in CMS project conf file if (not defined $p1) { # No ref in home dir project conf file so use the CMS one. $p2->{$ENV{'PBPROJ'}} = $p2->{'default'} if (not defined $p2->{$ENV{'PBPROJ'}}); $p1->{$ENV{'PBPROJ'}} = $p2->{$ENV{'PBPROJ'}}; } else { # Both are defined - handling the overloading if (not defined $p1->{'default'}) { if (defined $p2->{'default'}) { $p1->{'default'} = $p2->{'default'}; } } if (not defined $p1->{$ENV{'PBPROJ'}}) { if (defined $p2->{$ENV{'PBPROJ'}}) { $p1->{$ENV{'PBPROJ'}} = $p2->{$ENV{'PBPROJ'}}; } else { $p1->{$ENV{'PBPROJ'}} = $p1->{'default'}; } } } } die "No $param[$i] defined for $ENV{'PBPROJ'}" if (not defined $p1->{$ENV{'PBPROJ'}}); } #print "DEBUG: param: ".Dumper(@ptr)."\n" if ($debug >= 1); return(@ptr1); } sub pb_no_err { } # Function which returns a pointer on a hash # corresponding to a declaration (arg2) in a conf file (arg1) sub pb_conf_read { my $conffile = shift; my @param = @_; my $trace; my @ptr; my $debug = 0; if ($debug > 0) { $trace = 1; } else { $trace = 0; } my $config = AppConfig->new({ # Auto Create variables mentioned in Conf file CREATE => 1, DEBUG => $trace, ERROR => \&pb_no_err, GLOBAL => { # Each conf item is a hash ARGCOUNT => ARGCOUNT_HASH, }, }); $config->file($conffile); for my $param (@param) { push @ptr,$config->get($param); } print "DEBUG: params: ".Dumper(@param)." ".Dumper(@ptr)."\n" if ($debug >= 1); return(@ptr); } # Setup environment for CMS system sub pb_cms_init { my $proj = shift || undef; my $ret; my ($cms) = pb_conf_get("cms"); if ($cms->{$proj} eq "svn") { $ENV{'PBREVISION'}=`(cd "$ENV{'PBROOT'}" ; svnversion .)`; chomp($ENV{'PBREVISION'}); $ENV{'PBCMSLOG'}="svn log"; $ENV{'PBCMSLOGFILE'}="svn.log"; } elsif ($cms->{$proj} eq "flat") { $ENV{'PBREVISION'}="flat"; $ENV{'PBCMSLOG'}="/bin/true"; $ENV{'PBCMSLOGFILE'}="flat.log"; } elsif ($cms->{$proj} eq "cvs") { # Way too slow #$ENV{'PBREVISION'}=`(cd "$ENV{'PBROOT'}" ; 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{'PBCMSLOG'}="cvs log"; $ENV{'PBCMSLOGFILE'}="cvs.log"; # # Export content if needed # my ($cvsroot,$cvsrsh) = pb_conf_get("cvsroot","cvsrsh"); $ENV{'CVSROOT'} = $cvsroot->{$proj} if (defined $cvsroot->{$proj}); $ENV{'CVSRSH'} = $cvsrsh->{$proj} if (defined $cvsrsh->{$proj}); } else { die "cms $cms->{$proj} unknown"; } return($cms); } sub pb_cms_export { my $cms = shift; my $pbdate = shift || undef; my $source = shift; my $destdir = shift; my $tmp; my $tmp1; if ($cms->{$ENV{'PBPROJ'}} eq "svn") { if (-d $source) { $tmp = $destdir; } else { $tmp = $destdir."/".basename($source); } pb_system("svn export $source $tmp","Exporting $source from SVN to $tmp"); } elsif ($cms->{$ENV{'PBPROJ'}} eq "flat") { if (-d $source) { $tmp = $destdir; } else { $tmp = $destdir."/".basename($source); } pb_system("cp -a $source $tmp","Exporting $source from DIR to $tmp"); } elsif ($cms->{$ENV{'PBPROJ'}} eq "cvs") { my $dir=dirname($destdir); my $base=basename($destdir); if (-d $source) { $tmp1 = $source; $tmp1 =~ s|$ENV{'PBROOT'}/||; } else { $tmp1 = dirname($source); $tmp1 =~ s|$ENV{'PBROOT'}/||; $tmp1 = $tmp1."/".basename($source); } # CVS needs a relative path ! pb_system("cd $dir ; cvs export -D \"$pbdate\" -d $base $tmp1","Exporting $source from CVS to $destdir"); } else { die "cms $cms->{$ENV{'PBPROJ'}} unknown"; } } sub pb_cms_log { my $cms = shift; my $pkgdir = shift; my $destfile = shift; if ($cms->{$ENV{'PBPROJ'}} eq "svn") { pb_system("svn log -v $pkgdir > $destfile","Extracting log info from SVN"); } elsif ($cms->{$ENV{'PBPROJ'}} eq "flat") { # Nothing to do } elsif ($cms->{$ENV{'PBPROJ'}} eq "cvs") { my $tmp=basename($pkgdir); # CVS needs a relative path ! pb_system("cvs log $tmp > $destfile","Extracting log info from CVS"); } else { die "cms $cms->{$ENV{'PBPROJ'}} unknown"; } } sub pb_cms_getinfo { my $cms = shift; my $url = ""; my $void = ""; if ($cms->{$ENV{'PBPROJ'}} eq "svn") { open(PIPE,"LANGUAGE=C svn info $ENV{'PBROOT'} |") || die "Unable to get svn info from $ENV{'PBROOT'}"; while () { ($void,$url) = split(/^URL:/) if (/^URL:/); } close(PIPE); chomp($url); } elsif ($cms->{$ENV{'PBPROJ'}} eq "flat") { } elsif ($cms->{$ENV{'PBPROJ'}} eq "cvs") { } else { die "cms $cms->{$ENV{'PBPROJ'}} unknown"; } return($url); } sub pb_cms_copy { my $cms = shift; my $oldurl = shift; my $newurl = shift; if ($cms->{$ENV{'PBPROJ'}} eq "svn") { pb_system("svn copy -m \"Creation of $newurl from $oldurl\" $oldurl $newurl","Copying $oldurl to $newurl "); } elsif ($cms->{$ENV{'PBPROJ'}} eq "flat") { } elsif ($cms->{$ENV{'PBPROJ'}} eq "cvs") { } else { die "cms $cms->{$ENV{'PBPROJ'}} unknown"; } } sub pb_cms_checkout { my $cms = shift; my $url = shift; my $destination = shift; if ($cms->{$ENV{'PBPROJ'}} eq "svn") { pb_system("svn co $url $destination","Checking $url to $destination "); } elsif ($cms->{$ENV{'PBPROJ'}} eq "flat") { } elsif ($cms->{$ENV{'PBPROJ'}} eq "cvs") { } else { die "cms $cms->{$ENV{'PBPROJ'}} unknown"; } } sub pb_cms_checkin { my $cms = shift; my $dir = shift; my $ver = basename($dir); if ($cms->{$ENV{'PBPROJ'}} eq "svn") { pb_system("svn ci -m \"Updated to $ver\" $dir","Checking in $dir"); pb_system("svn up $dir","Updating $dir"); } elsif ($cms->{$ENV{'PBPROJ'}} eq "flat") { } elsif ($cms->{$ENV{'PBPROJ'}} eq "cvs") { } else { die "cms $cms->{$ENV{'PBPROJ'}} unknown"; } } sub pb_cms_isdiff { my $cms = shift; if ($cms->{$ENV{'PBPROJ'}} eq "svn") { open(PIPE,"svn diff $ENV{'PBROOT'} |") || die "Unable to get svn diff from $ENV{'PBROOT'}"; my $l = 0; while () { $l++; } return($l); } elsif ($cms->{$ENV{'PBPROJ'}} eq "flat") { } elsif ($cms->{$ENV{'PBPROJ'}} eq "cvs") { } else { die "cms $cms->{$ENV{'PBPROJ'}} unknown"; } } # Get all filters to apply # They're cumulative from less specific to most specific # suffix is .pbf sub pb_get_filters { # For the moment not dynamic my $debug = 0; # Debug level my $LOG = *STDOUT; # Where to log my @ffiles; my ($ffile00, $ffile0, $ffile1, $ffile2, $ffile3); my ($mfile00, $mfile0, $mfile1, $mfile2, $mfile3); my $pbpkg = shift || die "No package specified"; my $dtype = shift || ""; my $dfam = shift || ""; my $ddir = shift || ""; my $dver = shift || ""; my $ptr; # returned value pointer on the hash of filters my %ptr; # Global filter files first, then package specificities if (-d "$ENV{'PBCONF'}/pbfilter") { $mfile00 = "$ENV{'PBCONF'}/pbfilter/all.pbf" if (-f "$ENV{'PBCONF'}/pbfilter/all.pbf"); $mfile0 = "$ENV{'PBCONF'}/pbfilter/$dtype.pbf" if (-f "$ENV{'PBCONF'}/pbfilter/$dtype.pbf"); $mfile1 = "$ENV{'PBCONF'}/pbfilter/$dfam.pbf" if (-f "$ENV{'PBCONF'}/pbfilter/$dfam.pbf"); $mfile2 = "$ENV{'PBCONF'}/pbfilter/$ddir.pbf" if (-f "$ENV{'PBCONF'}/pbfilter/$ddir.pbf"); $mfile3 = "$ENV{'PBCONF'}/pbfilter/$ddir-$dver.pbf" if (-f "$ENV{'PBCONF'}/pbfilter/$ddir-$dver.pbf"); push @ffiles,$mfile00 if (defined $mfile00); push @ffiles,$mfile0 if (defined $mfile0); push @ffiles,$mfile1 if (defined $mfile1); push @ffiles,$mfile2 if (defined $mfile2); push @ffiles,$mfile3 if (defined $mfile3); } if (-d "$ENV{'PBCONF'}/$pbpkg/pbfilter") { $ffile00 = "$ENV{'PBCONF'}/$pbpkg/pbfilter/all.pbf" if (-f "$ENV{'PBCONF'}/$pbpkg/pbfilter/all.pbf"); $ffile0 = "$ENV{'PBCONF'}/$pbpkg/pbfilter/$dtype.pbf" if (-f "$ENV{'PBCONF'}/$pbpkg/pbfilter/$dtype.pbf"); $ffile1 = "$ENV{'PBCONF'}/$pbpkg/pbfilter/$dfam.pbf" if (-f "$ENV{'PBCONF'}/$pbpkg/pbfilter/$dfam.pbf"); $ffile2 = "$ENV{'PBCONF'}/$pbpkg/pbfilter/$ddir.pbf" if (-f "$ENV{'PBCONF'}/$pbpkg/pbfilter/$ddir.pbf"); $ffile3 = "$ENV{'PBCONF'}/$pbpkg/pbfilter/$ddir-$dver.pbf" if (-f "$ENV{'PBCONF'}/$pbpkg/pbfilter/$ddir-$dver.pbf"); push @ffiles,$ffile00 if (defined $ffile00); push @ffiles,$ffile0 if (defined $ffile0); push @ffiles,$ffile1 if (defined $ffile1); push @ffiles,$ffile2 if (defined $ffile2); push @ffiles,$ffile3 if (defined $ffile3); } if (@ffiles) { print $LOG "DEBUG ffiles: ".Dumper(\@ffiles)."\n" if ($debug >= 1); my $config = AppConfig->new({ # Auto Create variables mentioned in Conf file CREATE => 1, DEBUG => 0, GLOBAL => { # Each conf item is a hash ARGCOUNT => AppConfig::ARGCOUNT_HASH } }); $config->file(@ffiles); $ptr = $config->get("filter"); print $LOG "DEBUG f:".Dumper($ptr)."\n" if ($debug >= 1); } else { $ptr = { }; } %ptr = %$ptr; return(\%ptr); } # Function which applies filter on pb build files sub pb_filter_file_pb { my $f=shift; my $ptr=shift; my %filter=%$ptr; my $destfile=shift; my $dtype=shift; my $pbsuf=shift; my $pbpkg=shift; my $pbver=shift; my $pbtag=shift; my $pbrev=shift; my $pbdate=shift; my $defpkgdir = shift; my $extpkgdir = shift; my $pbpackager = shift; # For the moment not dynamic my $debug = 0; # Debug level my $LOG = *STDOUT; # Where to log print $LOG "DEBUG: From $f to $destfile\n" if ($debug >= 1); pb_mkdir_p(dirname($destfile)) if (! -d dirname($destfile)); open(DEST,"> $destfile") || die "Unable to create $destfile"; open(FILE,"$f") || die "Unable to open $f: $!"; while () { my $line = $_; foreach my $s (keys %filter) { # Process single variables print $LOG "DEBUG filter{$s}: $filter{$s}\n" if ($debug >= 1); my $tmp = $filter{$s}; next if (not defined $tmp); # Expand variables if any single one found print $LOG "DEBUG tmp: $tmp\n" if ($debug >= 1); if ($tmp =~ /\$/) { eval { $tmp =~ s/(\$\w+)/$1/eeg }; # special case for ChangeLog only for pb } elsif (($tmp =~ /^yes$/) && ($s =~ /^PBLOG$/) && ($line =~ /^PBLOG$/)) { $tmp = ""; my $p = $defpkgdir->{$pbpkg}; $p = $extpkgdir->{$pbpkg} if (not defined $p); pb_changelog($dtype, $pbpkg, $pbtag, $pbsuf, $p, \*DEST); } $line =~ s|$s|$tmp|; } print DEST $line; } close(FILE); close(DEST); } # Function which applies filter on files (external call) sub pb_filter_file { my $f=shift; my $ptr=shift; my %filter=%$ptr; my $destfile=shift; my $pbpkg=shift; my $pbver=shift; my $pbtag=shift; my $pbrev=shift; my $pbdate=shift; my $pbpackager=shift; # For the moment not dynamic my $debug = 0; # Debug level my $LOG = *STDOUT; # Where to log print $LOG "DEBUG: From $f to $destfile\n" if ($debug >= 1); pb_mkdir_p(dirname($destfile)) if (! -d dirname($destfile)); open(DEST,"> $destfile") || die "Unable to create $destfile"; open(FILE,"$f") || die "Unable to open $f: $!"; while () { my $line = $_; foreach my $s (keys %filter) { # Process single variables print $LOG "DEBUG filter{$s}: $filter{$s}\n" if ($debug > 1); my $tmp = $filter{$s}; next if (not defined $tmp); # Expand variables if any single one found if ($tmp =~ /\$/) { eval { $tmp =~ s/(\$\w+)/$1/eeg }; } $line =~ s|$s|$tmp|; } print DEST $line; } close(FILE); close(DEST); } 1;