Context Navigation

source: ProjectBuilder/devel/pb/lib/ProjectBuilder/Base.pm@ 262

Last change on this file since 262 was 262, checked in by Bruno Cornec, 16 years ago
Fix bug #7 where .pbrc nearly empty wasn't working
File size: 17.6 KB

Rev	Line
[2]	1	#!/usr/bin/perl -w
	2	#
[74]	3	# Base subroutines for the Project-Builder project
[2]	4	#
	5	# $Id$
	6	#
	7
[18]	8	use strict;
[5]	9	use lib qw (lib);
[2]	10	use File::Basename;
[9]	11	use File::Path;
[2]	12	use File::Temp qw /tempdir/;
[74]	13	use AppConfig qw(ARGCOUNT_HASH);
[8]	14	use Data::Dumper;
[2]	15
[199]	16	use ProjectBuilder::Changelog qw (pb_changelog);
	17
[49]	18	$ENV{'PBETC'} = "$ENV{'HOME'}/.pbrc";
[5]	19
[74]	20	sub pb_env_init {
[2]	21
[5]	22	my $proj=shift;
	23	my $ver;
	24	my $tag;
[2]	25
[107]	26	# For the moment not dynamic
	27	my $debug = 0; # Debug level
	28	my $LOG = *STDOUT; # Where to log
	29
[8]	30	#
[5]	31	# Check project name
[49]	32	# Could be with env var PBPROJ
	33	# or option -p
	34	# if not define take the first in conf file
[8]	35	#
[5]	36	if ((defined $ENV{'PBPROJ'}) &&
	37	(not (defined $proj))) {
	38	$proj = $ENV{'PBPROJ'};
	39	}
[69]	40
[49]	41	#
[69]	42	# We get the pbrc file for that project
	43	# and use its content
	44	#
[89]	45	my ($pbrc) = pb_conf_read("$ENV{'PBETC'}","pbrc");
[74]	46	print "DEBUG pbrc: ".Dumper($pbrc)."\n" if ($debug >= 1);
[69]	47
[108]	48	my %pbrc = %$pbrc;
[69]	49	if (not defined $proj) {
	50	# Take the first as the default project
	51	$proj = (keys %pbrc)[0];
	52	print $LOG "Using $proj as default project as none has been specified\n" if (($debug >= 0) and (defined $proj));
	53	}
	54	die "No project defined - use env var PBPROJ or -p proj" if (not (defined $proj));
	55
	56	#
	57	# Set delivery directory
	58	#
[71]	59	my $topdir=dirname($pbrc{$proj});
[108]	60	# Expand potential env variable in it
	61	eval { $topdir =~ s/(\$ENV.+\})/$1/eeg };
[69]	62	chdir $topdir \|\| die "Unable to change directory to $topdir";
[108]	63	$pbrc{$proj} = $topdir."/pbrc";
[69]	64	$ENV{'PBDESTDIR'}=$topdir."/delivery";
	65
	66	#
[67]	67	# Use project configuration file if needed
[49]	68	#
[67]	69	if (not defined $ENV{'PBROOT'}) {
[69]	70	if (-f $pbrc{$proj}) {
[89]	71	my ($pbroot) = pb_conf_read($pbrc{$proj},"pbroot");
[71]	72	my %pbroot = %$pbroot;
[77]	73	# All lines should point to the same pbroot so take the first
[69]	74	$ENV{'PBROOT'} = (values %$pbroot)[0] if (defined $pbroot);
	75	print $LOG "Using $ENV{'PBROOT'} as default pbroot from $pbrc{$proj}\n" if (($debug >= 0) and (defined $ENV{'PBROOT'}));
[67]	76	}
[69]	77	die "No pbroot defined - use env var PBROOT or -r pbroot " if (not defined $ENV{'PBROOT'});
[49]	78	}
[2]	79
[8]	80	#
[49]	81	# Check pb conf compliance
[8]	82	#
[49]	83	$ENV{'PBCONF'} = "$ENV{'PBROOT'}/pbconf";
	84	die "Project $proj not Project-Builder compliant. Please populate $ENV{'PBCONF'}" if ( not -d "$ENV{'PBCONF'}");
[2]	85
[74]	86	my %version = ();
[108]	87	my %defpkgdir = ();
	88	my %extpkgdir = ();
	89	my %filteredfiles = ();
[74]	90
[49]	91	if (-f "$ENV{'PBCONF'}/$proj.pb") {
[74]	92	# List of pkg to build by default (mandatory)
	93	# List of additional pkg to build when all is called (optional)
	94	# Valid version names (optional)
	95	# List of files to filter (optional)
[105]	96	my ($defpkgdir, $extpkgdir, $version, $filteredfiles, $pkgv, $pkgt) = pb_conf_read("$ENV{'PBCONF'}/$proj.pb","defpkgdir","extpkgdir","version","filteredfiles","projver","projtag");
[74]	97	print "DEBUG: defpkgdir: ".Dumper($defpkgdir)."\n" if ($debug >= 1);
	98	print "DEBUG: extpkgdir: ".Dumper($extpkgdir)."\n" if ($debug >= 1);
	99	print "DEBUG: version: ".Dumper($version)."\n" if ($debug >= 1);
	100	print "DEBUG: filteredfiles: ".Dumper($filteredfiles)."\n" if ($debug >= 1);
	101	die "Unable to find defpkgdir in $ENV{'PBCONF'}/$proj.pb" if (not defined $defpkgdir);
	102	# Global
	103	%defpkgdir = %$defpkgdir;
	104	# Global
[114]	105	%extpkgdir = %$extpkgdir if (defined $extpkgdir);
[74]	106	%version = %$version if (defined $version);
	107	# Global
	108	%filteredfiles = %$filteredfiles if (defined $filteredfiles);
[106]	109	#
	110	# Get global Version/Tag
	111	#
[38]	112
[106]	113	if (not defined $ENV{'PBVER'}) {
	114	if ((defined $pkgv) && (defined $pkgv->{$proj})) {
	115	$ENV{'PBVER'}=$pkgv->{$proj};
	116	} else {
	117	die "No projver found in $ENV{'PBCONF'}/$proj.pb";
	118	}
[98]	119	}
[106]	120	die "Invalid version name $ENV{'PBVER'} in $ENV{'PBCONF'}/$proj.pb" if (($ENV{'PBVER'} !~ /[0-9.]+/) && (not exists $version{$ENV{'PBVER'}}));
	121
	122	if (not defined $ENV{'PBTAG'}) {
	123	if ((defined $pkgt) && (defined $pkgt->{$proj})) {
	124	$ENV{'PBTAG'}=$pkgt->{$proj};
	125	} else {
	126	die "No projtag found in $ENV{'PBCONF'}/$proj.pb";
	127	}
[98]	128	}
[106]	129	die "Invalid tag name $ENV{'PBTAG'} in $ENV{'PBCONF'}/$proj.pb" if ($ENV{'PBTAG'} !~ /[0-9.]+/);
	130	} else {
	131	die "Unable to open $ENV{'PBCONF'}/$proj.pb";
[98]	132	}
	133
[8]	134	#
[105]	135	# Set temp directory
	136	#
	137	if (not defined $ENV{'TMPDIR'}) {
	138	$ENV{'TMPDIR'}="/tmp";
	139	}
	140	$ENV{'PBTMP'} = tempdir( "pb.XXXXXXXXXX", DIR => $ENV{'TMPDIR'}, CLEANUP => 1 );
	141
	142	#
[69]	143	# Removes all directory existing below the delivery dir
	144	# as they are temp dir only
[68]	145	# Files stay and have to be cleaned up manually
[8]	146	#
[25]	147	if (-d $ENV{'PBDESTDIR'}) {
	148	opendir(DIR,$ENV{'PBDESTDIR'}) \|\| die "Unable to open directory $ENV{'PBDESTDIR'}: $!";
	149	foreach my $d (readdir(DIR)) {
	150	next if ($d =~ /^\./);
[68]	151	next if (-f "$ENV{'PBDESTDIR'}/$d");
[74]	152	pb_rm_rf("$ENV{'PBDESTDIR'}/$d") if (-d "$ENV{'PBDESTDIR'}/$d");
[25]	153	}
	154	closedir(DIR);
	155	}
	156	if (! -d "$ENV{'PBDESTDIR'}") {
[74]	157	pb_mkdir_p($ENV{'PBDESTDIR'}) \|\| die "Unable to recursively create $ENV{'PBDESTDIR'}";
[25]	158	}
[5]	159
[25]	160	#
	161	# Set build directory
	162	#
[71]	163	$ENV{'PBBUILDDIR'}=$topdir."/build";
[101]	164	if (! -d "$ENV{'PBBUILDDIR'}") {
	165	pb_mkdir_p($ENV{'PBBUILDDIR'}) \|\| die "Unable to recursively create $ENV{'PBBUILDDIR'}";
	166	}
[25]	167
[8]	168	umask 0022;
[107]	169	return($proj,$debug,$LOG,\%pbrc, \%filteredfiles, \%defpkgdir, \%extpkgdir);
[2]	170	}
[9]	171
[74]	172	# Internal mkdir -p function
	173	sub pb_mkdir_p {
[29]	174	my @dir = @_;
	175	my $ret = mkpath(@dir, 0, 0755);
	176	return($ret);
[9]	177	}
	178
[74]	179	# Internal rm -rf function
	180	sub pb_rm_rf {
[29]	181	my @dir = @_;
	182	my $ret = rmtree(@dir, 0, 0);
	183	return($ret);
[9]	184	}
	185
[74]	186	# Internal system function
	187	sub pb_system {
[29]	188
	189	my $cmd=shift;
[30]	190	my $cmt=shift \|\| $cmd;
[29]	191
[108]	192	print "$cmt... ";
[117]	193	#system("$cmd 2>&1 > $ENV{'PBTMP'}/system.log");
	194	system("$cmd");
[29]	195	if ($? == -1) {
[108]	196	print "failed to execute ($cmd) : $!\n";
[106]	197	pb_display_file("$ENV{'PBTMP'}/system.log");
[29]	198	} elsif ($? & 127) {
[108]	199	printf "child ($cmd) died with signal %d, %s coredump\n", ($? & 127), ($? & 128) ? 'with' : 'without';
[106]	200	pb_display_file("$ENV{'PBTMP'}/system.log");
	201	} elsif ($? == 0) {
[108]	202	print "OK\n";
[29]	203	} else {
[106]	204	printf "child ($cmd) exited with value %d\n", $? >> 8;
	205	pb_display_file("$ENV{'PBTMP'}/system.log");
[29]	206	}
[30]	207	}
[74]	208
[106]	209	sub pb_display_file {
	210
	211	my $file=shift;
	212
[117]	213	return if (not -f $file);
	214	open(FILE,"$file");
[106]	215	while (<FILE>) {
[108]	216	print $_;
[106]	217	}
	218	close(FILE);
	219	}
	220
[242]	221	# Function which returns a pointer on a table
	222	# corresponding to a set of values queried in the conf file
[88]	223	# and test the returned vaue as they need to exist in that case
	224	sub pb_conf_get {
	225
	226	my @param = @_;
	227
[242]	228	# Everything is returned via ptr1
	229	my @ptr1 = pb_conf_read("$ENV{'PBETC'}", @param);
	230	my @ptr2 = pb_conf_read("$ENV{'PBCONF'}/$ENV{'PBPROJ'}.pb", @param);
[89]	231
[242]	232	my $p1;
	233	my $p2;
	234
[262]	235	#print "DEBUG: param1: ".Dumper(@ptr1)."\n"; # if ($debug >= 1);
	236	#print "DEBUG: param2: ".Dumper(@ptr2)."\n"; # if ($debug >= 1);
	237
[88]	238	foreach my $i (0..$#param) {
[262]	239	$p1 = $ptr1[$i];
	240	$p2 = $ptr2[$i];
	241	die "No $param[$i] defined for $ENV{'PBPROJ'}" if ((not defined @ptr1) && (not defined @ptr2));
	242	die "No $param[$i] defined for $ENV{'PBPROJ'}" if ((not defined $p1) && (not defined $p2));
[242]	243	# Always try to take the param from the home dir conf file in priority
	244	# in order to mask what could be defined under the CMS to allow for overloading
	245	if (not defined $p2) {
	246	# No ref in CMS project conf file so use the home dir one.
	247	$p1->{$ENV{'PBPROJ'}} = $p1->{'default'} if (not defined $p1->{$ENV{'PBPROJ'}});
	248	} else {
	249	# Ref found in CMS project conf file
	250	if (not defined $p1) {
	251	# No ref in home dir project conf file so use the CMS one.
	252	$p2->{$ENV{'PBPROJ'}} = $p2->{'default'} if (not defined $p2->{$ENV{'PBPROJ'}});
	253	$p1->{$ENV{'PBPROJ'}} = $p2->{$ENV{'PBPROJ'}};
	254	} else {
	255	# Both are defined - handling the overloading
	256	if (not defined $p1->{'default'}) {
	257	if (defined $p2->{'default'}) {
	258	$p1->{'default'} = $p2->{'default'};
	259	}
	260	}
	261
	262	if (not defined $p1->{$ENV{'PBPROJ'}}) {
	263	if (defined $p2->{$ENV{'PBPROJ'}}) {
	264	$p1->{$ENV{'PBPROJ'}} = $p2->{$ENV{'PBPROJ'}};
	265	} else {
	266	$p1->{$ENV{'PBPROJ'}} = $p1->{'default'};
	267	}
	268	}
	269	}
	270	}
	271	die "No $param[$i] defined for $ENV{'PBPROJ'}" if (not defined $p1->{$ENV{'PBPROJ'}});
[262]	272	$ptr1[$i] = $p1;
	273	#print "DEBUG: param ptr1: ".Dumper(@ptr1)."\n"; # if ($debug >= 1);
[88]	274	}
[242]	275	return(@ptr1);
[88]	276	}
	277
[242]	278	sub pb_no_err {
	279	}
	280
[88]	281	# Function which returns a pointer on a hash
[74]	282	# corresponding to a declaration (arg2) in a conf file (arg1)
	283	sub pb_conf_read {
	284
	285	my $conffile = shift;
	286	my @param = @_;
	287	my $trace;
	288	my @ptr;
	289
[108]	290	my $debug = 0;
	291
[74]	292	if ($debug > 0) {
	293	$trace = 1;
	294	} else {
	295	$trace = 0;
	296	}
	297
	298
	299	my $config = AppConfig->new({
	300	# Auto Create variables mentioned in Conf file
	301	CREATE => 1,
	302	DEBUG => $trace,
[242]	303	ERROR => \&pb_no_err,
[74]	304	GLOBAL => {
	305	# Each conf item is a hash
	306	ARGCOUNT => ARGCOUNT_HASH,
	307	},
	308	});
	309	$config->file($conffile);
	310	for my $param (@param) {
	311	push @ptr,$config->get($param);
	312	}
[89]	313	print "DEBUG: params: ".Dumper(@param)." ".Dumper(@ptr)."\n" if ($debug >= 1);
	314	return(@ptr);
[74]	315	}
	316
	317	# Setup environment for CMS system
	318	sub pb_cms_init {
	319
	320	my $proj = shift \|\| undef;
	321	my $ret;
	322
[89]	323	my ($cms) = pb_conf_get("cms");
[74]	324
[88]	325	if ($cms->{$proj} eq "svn") {
[74]	326	$ENV{'PBREVISION'}=`(cd "$ENV{'PBROOT'}" ; svnversion .)`;
	327	chomp($ENV{'PBREVISION'});
	328	$ENV{'PBCMSLOG'}="svn log";
	329	$ENV{'PBCMSLOGFILE'}="svn.log";
[226]	330	} elsif ($cms->{$proj} eq "flat") {
	331	$ENV{'PBREVISION'}="flat";
	332	$ENV{'PBCMSLOG'}="/bin/true";
[227]	333	$ENV{'PBCMSLOGFILE'}="flat.log";
[88]	334	} elsif ($cms->{$proj} eq "cvs") {
[106]	335	# Way too slow
	336	#$ENV{'PBREVISION'}=`(cd "$ENV{'PBROOT'}" ; cvs rannotate -f . 2>&1 \| awk '{print \$1}' \| grep -E '^[0-9]' \| cut -d. -f2 \|sort -nu \| tail -1)`;
	337	#chomp($ENV{'PBREVISION'});
	338	$ENV{'PBREVISION'}="CVS";
[74]	339	$ENV{'PBCMSLOG'}="cvs log";
	340	$ENV{'PBCMSLOGFILE'}="cvs.log";
[87]	341	#
	342	# Export content if needed
	343	#
[242]	344	my ($cvsroot,$cvsrsh) = pb_conf_get("cvsroot","cvsrsh");
[88]	345	$ENV{'CVSROOT'} = $cvsroot->{$proj} if (defined $cvsroot->{$proj});
[112]	346	$ENV{'CVSRSH'} = $cvsrsh->{$proj} if (defined $cvsrsh->{$proj});
[74]	347	} else {
[88]	348	die "cms $cms->{$proj} unknown";
[74]	349	}
[106]	350	return($cms);
[74]	351	}
	352
[106]	353	sub pb_cms_export {
	354	my $cms = shift;
	355	my $pbdate = shift \|\| undef;
[108]	356	my $source = shift;
[106]	357	my $destdir = shift;
[108]	358	my $tmp;
[115]	359	my $tmp1;
[106]	360
	361	if ($cms->{$ENV{'PBPROJ'}} eq "svn") {
[108]	362	if (-d $source) {
	363	$tmp = $destdir;
	364	} else {
	365	$tmp = $destdir."/".basename($source);
	366	}
[116]	367	pb_system("svn export $source $tmp","Exporting $source from SVN to $tmp");
[226]	368	} elsif ($cms->{$ENV{'PBPROJ'}} eq "flat") {
	369	if (-d $source) {
	370	$tmp = $destdir;
	371	} else {
	372	$tmp = $destdir."/".basename($source);
	373	}
	374	pb_system("cp -a $source $tmp","Exporting $source from DIR to $tmp");
[106]	375	} elsif ($cms->{$ENV{'PBPROJ'}} eq "cvs") {
	376	my $dir=dirname($destdir);
	377	my $base=basename($destdir);
[115]	378	if (-d $source) {
	379	$tmp1 = $source;
	380	$tmp1 =~ s\|$ENV{'PBROOT'}/\|\|;
	381	} else {
	382	$tmp1 = dirname($source);
	383	$tmp1 =~ s\|$ENV{'PBROOT'}/\|\|;
	384	$tmp1 = $tmp1."/".basename($source);
	385	}
[106]	386	# CVS needs a relative path !
[115]	387	pb_system("cd $dir ; cvs export -D \"$pbdate\" -d $base $tmp1","Exporting $source from CVS to $destdir");
[106]	388	} else {
	389	die "cms $cms->{$ENV{'PBPROJ'}} unknown";
	390	}
	391	}
	392
	393	sub pb_cms_log {
	394	my $cms = shift;
	395	my $pkgdir = shift;
	396	my $destfile = shift;
	397
	398	if ($cms->{$ENV{'PBPROJ'}} eq "svn") {
[112]	399	pb_system("svn log -v $pkgdir > $destfile","Extracting log info from SVN");
[226]	400	} elsif ($cms->{$ENV{'PBPROJ'}} eq "flat") {
	401	# Nothing to do
[106]	402	} elsif ($cms->{$ENV{'PBPROJ'}} eq "cvs") {
	403	my $tmp=basename($pkgdir);
	404	# CVS needs a relative path !
	405	pb_system("cvs log $tmp > $destfile","Extracting log info from CVS");
	406	} else {
	407	die "cms $cms->{$ENV{'PBPROJ'}} unknown";
	408	}
	409	}
	410
[204]	411	sub pb_cms_getinfo {
	412	my $cms = shift;
	413	my $url = "";
	414	my $void = "";
[106]	415
[204]	416	if ($cms->{$ENV{'PBPROJ'}} eq "svn") {
	417	open(PIPE,"LANGUAGE=C svn info $ENV{'PBROOT'} \|") \|\| die "Unable to get svn info from $ENV{'PBROOT'}";
	418	while (<PIPE>) {
[206]	419	($void,$url) = split(/^URL:/) if (/^URL:/);
[204]	420	}
	421	close(PIPE);
[205]	422	chomp($url);
[226]	423	} elsif ($cms->{$ENV{'PBPROJ'}} eq "flat") {
[204]	424	} elsif ($cms->{$ENV{'PBPROJ'}} eq "cvs") {
	425	} else {
	426	die "cms $cms->{$ENV{'PBPROJ'}} unknown";
	427	}
	428	return($url);
	429	}
	430
	431	sub pb_cms_copy {
	432	my $cms = shift;
	433	my $oldurl = shift;
	434	my $newurl = shift;
	435
	436	if ($cms->{$ENV{'PBPROJ'}} eq "svn") {
[212]	437	pb_system("svn copy -m \"Creation of $newurl from $oldurl\" $oldurl $newurl","Copying $oldurl to $newurl ");
[226]	438	} elsif ($cms->{$ENV{'PBPROJ'}} eq "flat") {
[204]	439	} elsif ($cms->{$ENV{'PBPROJ'}} eq "cvs") {
	440	} else {
	441	die "cms $cms->{$ENV{'PBPROJ'}} unknown";
	442	}
	443	}
	444
	445	sub pb_cms_checkout {
	446	my $cms = shift;
	447	my $url = shift;
	448	my $destination = shift;
	449
	450	if ($cms->{$ENV{'PBPROJ'}} eq "svn") {
	451	pb_system("svn co $url $destination","Checking $url to $destination ");
[226]	452	} elsif ($cms->{$ENV{'PBPROJ'}} eq "flat") {
[204]	453	} elsif ($cms->{$ENV{'PBPROJ'}} eq "cvs") {
	454	} else {
	455	die "cms $cms->{$ENV{'PBPROJ'}} unknown";
	456	}
	457	}
	458
[208]	459	sub pb_cms_checkin {
	460	my $cms = shift;
	461	my $dir = shift;
	462
[212]	463	my $ver = basename($dir);
[208]	464	if ($cms->{$ENV{'PBPROJ'}} eq "svn") {
[212]	465	pb_system("svn ci -m \"Updated to $ver\" $dir","Checking in $dir");
[208]	466	pb_system("svn up $dir","Updating $dir");
[226]	467	} elsif ($cms->{$ENV{'PBPROJ'}} eq "flat") {
[208]	468	} elsif ($cms->{$ENV{'PBPROJ'}} eq "cvs") {
	469	} else {
	470	die "cms $cms->{$ENV{'PBPROJ'}} unknown";
	471	}
	472	}
	473
[204]	474	sub pb_cms_isdiff {
	475	my $cms = shift;
	476
	477	if ($cms->{$ENV{'PBPROJ'}} eq "svn") {
	478	open(PIPE,"svn diff $ENV{'PBROOT'} \|") \|\| die "Unable to get svn diff from $ENV{'PBROOT'}";
	479	my $l = 0;
	480	while (<PIPE>) {
	481	$l++;
	482	}
	483	return($l);
[226]	484	} elsif ($cms->{$ENV{'PBPROJ'}} eq "flat") {
[204]	485	} elsif ($cms->{$ENV{'PBPROJ'}} eq "cvs") {
	486	} else {
	487	die "cms $cms->{$ENV{'PBPROJ'}} unknown";
	488	}
	489	}
	490
[77]	491	# Get all filters to apply
	492	# They're cumulative from less specific to most specific
	493	# suffix is .pbf
	494
	495	sub pb_get_filters {
	496
[108]	497	# For the moment not dynamic
	498	my $debug = 0; # Debug level
	499	my $LOG = *STDOUT; # Where to log
	500
[77]	501	my @ffiles;
[235]	502	my ($ffile00, $ffile0, $ffile1, $ffile2, $ffile3);
	503	my ($mfile00, $mfile0, $mfile1, $mfile2, $mfile3);
[77]	504	my $pbpkg = shift \|\| die "No package specified";
[236]	505	my $dtype = shift \|\| "";
	506	my $dfam = shift \|\| "";
	507	my $ddir = shift \|\| "";
	508	my $dver = shift \|\| "";
[77]	509	my $ptr; # returned value pointer on the hash of filters
[79]	510	my %ptr;
[77]	511
[169]	512	# Global filter files first, then package specificities
	513	if (-d "$ENV{'PBCONF'}/pbfilter") {
[231]	514	$mfile00 = "$ENV{'PBCONF'}/pbfilter/all.pbf" if (-f "$ENV{'PBCONF'}/pbfilter/all.pbf");
[169]	515	$mfile0 = "$ENV{'PBCONF'}/pbfilter/$dtype.pbf" if (-f "$ENV{'PBCONF'}/pbfilter/$dtype.pbf");
	516	$mfile1 = "$ENV{'PBCONF'}/pbfilter/$dfam.pbf" if (-f "$ENV{'PBCONF'}/pbfilter/$dfam.pbf");
	517	$mfile2 = "$ENV{'PBCONF'}/pbfilter/$ddir.pbf" if (-f "$ENV{'PBCONF'}/pbfilter/$ddir.pbf");
	518	$mfile3 = "$ENV{'PBCONF'}/pbfilter/$ddir-$dver.pbf" if (-f "$ENV{'PBCONF'}/pbfilter/$ddir-$dver.pbf");
	519
[231]	520	push @ffiles,$mfile00 if (defined $mfile00);
[169]	521	push @ffiles,$mfile0 if (defined $mfile0);
	522	push @ffiles,$mfile1 if (defined $mfile1);
	523	push @ffiles,$mfile2 if (defined $mfile2);
	524	push @ffiles,$mfile3 if (defined $mfile3);
	525	}
	526
[77]	527	if (-d "$ENV{'PBCONF'}/$pbpkg/pbfilter") {
[231]	528	$ffile00 = "$ENV{'PBCONF'}/$pbpkg/pbfilter/all.pbf" if (-f "$ENV{'PBCONF'}/$pbpkg/pbfilter/all.pbf");
[77]	529	$ffile0 = "$ENV{'PBCONF'}/$pbpkg/pbfilter/$dtype.pbf" if (-f "$ENV{'PBCONF'}/$pbpkg/pbfilter/$dtype.pbf");
	530	$ffile1 = "$ENV{'PBCONF'}/$pbpkg/pbfilter/$dfam.pbf" if (-f "$ENV{'PBCONF'}/$pbpkg/pbfilter/$dfam.pbf");
	531	$ffile2 = "$ENV{'PBCONF'}/$pbpkg/pbfilter/$ddir.pbf" if (-f "$ENV{'PBCONF'}/$pbpkg/pbfilter/$ddir.pbf");
	532	$ffile3 = "$ENV{'PBCONF'}/$pbpkg/pbfilter/$ddir-$dver.pbf" if (-f "$ENV{'PBCONF'}/$pbpkg/pbfilter/$ddir-$dver.pbf");
	533
[231]	534	push @ffiles,$ffile00 if (defined $ffile00);
[77]	535	push @ffiles,$ffile0 if (defined $ffile0);
	536	push @ffiles,$ffile1 if (defined $ffile1);
	537	push @ffiles,$ffile2 if (defined $ffile2);
	538	push @ffiles,$ffile3 if (defined $ffile3);
	539	}
	540	if (@ffiles) {
	541	print $LOG "DEBUG ffiles: ".Dumper(\@ffiles)."\n" if ($debug >= 1);
[79]	542
	543	my $config = AppConfig->new({
	544	# Auto Create variables mentioned in Conf file
	545	CREATE => 1,
	546	DEBUG => 0,
	547	GLOBAL => {
	548	# Each conf item is a hash
	549	ARGCOUNT => AppConfig::ARGCOUNT_HASH
	550	}
	551	});
	552
[77]	553	$config->file(@ffiles);
	554	$ptr = $config->get("filter");
	555	print $LOG "DEBUG f:".Dumper($ptr)."\n" if ($debug >= 1);
	556	} else {
	557	$ptr = { };
	558	}
[79]	559	%ptr = %$ptr;
	560	return(\%ptr);
[77]	561	}
	562
[236]	563	# Function which applies filter on pb build files
[77]	564	sub pb_filter_file_pb {
	565
	566	my $f=shift;
	567	my $ptr=shift;
	568	my %filter=%$ptr;
	569	my $destfile=shift;
	570	my $dtype=shift;
[99]	571	my $pbsuf=shift;
[80]	572	my $pbpkg=shift;
	573	my $pbver=shift;
	574	my $pbtag=shift;
	575	my $pbrev=shift;
	576	my $pbdate=shift;
[108]	577	my $defpkgdir = shift;
	578	my $extpkgdir = shift;
[174]	579	my $pbpackager = shift;
[77]	580
[108]	581	# For the moment not dynamic
	582	my $debug = 0; # Debug level
	583	my $LOG = *STDOUT; # Where to log
	584
[77]	585	print $LOG "DEBUG: From $f to $destfile\n" if ($debug >= 1);
	586	pb_mkdir_p(dirname($destfile)) if (! -d dirname($destfile));
	587	open(DEST,"> $destfile") \|\| die "Unable to create $destfile";
	588	open(FILE,"$f") \|\| die "Unable to open $f: $!";
	589	while (<FILE>) {
	590	my $line = $_;
	591	foreach my $s (keys %filter) {
	592	# Process single variables
[79]	593	print $LOG "DEBUG filter{$s}: $filter{$s}\n" if ($debug >= 1);
[77]	594	my $tmp = $filter{$s};
	595	next if (not defined $tmp);
	596	# Expand variables if any single one found
[79]	597	print $LOG "DEBUG tmp: $tmp\n" if ($debug >= 1);
[77]	598	if ($tmp =~ /\$/) {
	599	eval { $tmp =~ s/(\$\w+)/$1/eeg };
	600	# special case for ChangeLog only for pb
[259]	601	} elsif (($s =~ /^PBLOG$/) && ($line =~ /^PBLOG$/)) {
[108]	602	my $p = $defpkgdir->{$pbpkg};
	603	$p = $extpkgdir->{$pbpkg} if (not defined $p);
[254]	604	pb_changelog($dtype, $pbpkg, $pbver, $pbtag, $pbsuf, $p, \*DEST, $tmp);
	605	$tmp = "";
[77]	606	}
	607	$line =~ s\|$s\|$tmp\|;
	608	}
	609	print DEST $line;
	610	}
	611	close(FILE);
	612	close(DEST);
	613	}
	614
	615	# Function which applies filter on files (external call)
	616	sub pb_filter_file {
	617
	618	my $f=shift;
	619	my $ptr=shift;
	620	my %filter=%$ptr;
	621	my $destfile=shift;
[80]	622	my $pbpkg=shift;
	623	my $pbver=shift;
	624	my $pbtag=shift;
	625	my $pbrev=shift;
	626	my $pbdate=shift;
[174]	627	my $pbpackager=shift;
[77]	628
[108]	629	# For the moment not dynamic
	630	my $debug = 0; # Debug level
	631	my $LOG = *STDOUT; # Where to log
	632
[77]	633	print $LOG "DEBUG: From $f to $destfile\n" if ($debug >= 1);
	634	pb_mkdir_p(dirname($destfile)) if (! -d dirname($destfile));
	635	open(DEST,"> $destfile") \|\| die "Unable to create $destfile";
	636	open(FILE,"$f") \|\| die "Unable to open $f: $!";
	637	while (<FILE>) {
	638	my $line = $_;
	639	foreach my $s (keys %filter) {
	640	# Process single variables
	641	print $LOG "DEBUG filter{$s}: $filter{$s}\n" if ($debug > 1);
	642	my $tmp = $filter{$s};
	643	next if (not defined $tmp);
	644	# Expand variables if any single one found
	645	if ($tmp =~ /\$/) {
	646	eval { $tmp =~ s/(\$\w+)/$1/eeg };
	647	}
	648	$line =~ s\|$s\|$tmp\|;
	649	}
	650	print DEST $line;
	651	}
	652	close(FILE);
	653	close(DEST);
	654	}
	655
	656
[2]	657	1;

Note: See TracBrowser for help on using the repository browser.

Download in other formats: