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

Last change on this file since 107 was 107, checked in by bruno, 12 years ago

Change intereface of pb_env_init to allow Base.pm to be completely standalone.
Needded to be called from pbinit in projects, such as mondo

  • Property svn:executable set to *
File size: 12.3 KB
Line 
1#!/usr/bin/perl -w
2#
3# Base subroutines for the Project-Builder project
4#
5# $Id$
6#
7
8use strict;
9use lib qw (lib);
10use File::Basename;
11use File::Path;
12use File::Temp qw /tempdir/;
13use AppConfig qw(ARGCOUNT_HASH);
14use Data::Dumper;
15
16$ENV{'PBETC'} = "$ENV{'HOME'}/.pbrc";
17
18sub pb_env_init {
19
20my $proj=shift;
21my $ver;
22my $tag;
23
24# For the moment not dynamic
25my $debug = 0;                  # Debug level
26my $LOG = *STDOUT;              # Where to log
27
28#
29# Check project name
30# Could be with env var PBPROJ
31# or option -p
32# if not define take the first in conf file
33#
34if ((defined $ENV{'PBPROJ'}) &&
35    (not (defined $proj))) {
36    $proj = $ENV{'PBPROJ'};
37}
38
39#
40# We get the pbrc file for that project
41# and use its content
42#
43my ($pbrc) = pb_conf_read("$ENV{'PBETC'}","pbrc");
44print "DEBUG pbrc: ".Dumper($pbrc)."\n" if ($debug >= 1);
45
46%pbrc = %$pbrc;
47if (not defined $proj) {
48    # Take the first as the default project
49    $proj = (keys %pbrc)[0];
50    print $LOG "Using $proj as default project as none has been specified\n" if (($debug >= 0) and (defined $proj));
51}
52die "No project defined - use env var PBPROJ or -p proj" if (not (defined $proj));
53
54#
55# Set delivery directory
56#
57my $topdir=dirname($pbrc{$proj});
58chdir $topdir || die "Unable to change directory to $topdir";
59$ENV{'PBDESTDIR'}=$topdir."/delivery";
60
61#
62# Use project configuration file if needed
63#
64if (not defined $ENV{'PBROOT'}) {
65    if (-f $pbrc{$proj}) {
66        my ($pbroot) = pb_conf_read($pbrc{$proj},"pbroot");
67        my %pbroot = %$pbroot;
68        # All lines should point to the same pbroot so take the first
69        $ENV{'PBROOT'} = (values %$pbroot)[0] if (defined $pbroot); 
70        print $LOG "Using $ENV{'PBROOT'} as default pbroot from $pbrc{$proj}\n" if (($debug >= 0) and (defined $ENV{'PBROOT'}));
71    }
72    die "No pbroot defined - use env var PBROOT or -r pbroot " if (not defined $ENV{'PBROOT'});
73}
74
75#
76# Check pb conf compliance
77#
78$ENV{'PBCONF'} = "$ENV{'PBROOT'}/pbconf";
79die "Project $proj not Project-Builder compliant. Please populate $ENV{'PBCONF'}" if ( not -d "$ENV{'PBCONF'}");
80
81my %version = ();
82
83if (-f "$ENV{'PBCONF'}/$proj.pb") {
84    # List of pkg to build by default (mandatory)
85    # List of additional pkg to build when all is called (optional)
86    # Valid version names (optional)
87    # List of files to filter (optional)
88    my ($defpkgdir, $extpkgdir, $version, $filteredfiles, $pkgv, $pkgt) = pb_conf_read("$ENV{'PBCONF'}/$proj.pb","defpkgdir","extpkgdir","version","filteredfiles","projver","projtag");
89    print "DEBUG: defpkgdir: ".Dumper($defpkgdir)."\n" if ($debug >= 1);
90    print "DEBUG: extpkgdir: ".Dumper($extpkgdir)."\n" if ($debug >= 1);
91    print "DEBUG: version: ".Dumper($version)."\n" if ($debug >= 1);
92    print "DEBUG: filteredfiles: ".Dumper($filteredfiles)."\n" if ($debug >= 1);
93    die "Unable to find defpkgdir in $ENV{'PBCONF'}/$proj.pb" if (not defined $defpkgdir);
94    # Global
95    %defpkgdir = %$defpkgdir;
96    # Global
97    %extpkgdir = ();
98    %extpkgdir = %$defpkgdir if (defined $defpkgdir);
99    %version = ();
100    %version = %$version if (defined $version);
101    # Global
102    %filteredfiles = ();
103    %filteredfiles = %$filteredfiles if (defined $filteredfiles);
104    #
105    # Get global Version/Tag
106    #
107
108    if (not defined $ENV{'PBVER'}) {
109        if ((defined $pkgv) && (defined $pkgv->{$proj})) {
110            $ENV{'PBVER'}=$pkgv->{$proj};
111        } else {
112            die "No projver found in $ENV{'PBCONF'}/$proj.pb";
113        }
114    }
115    die "Invalid version name $ENV{'PBVER'} in $ENV{'PBCONF'}/$proj.pb" if (($ENV{'PBVER'} !~ /[0-9.]+/) && (not exists $version{$ENV{'PBVER'}}));
116   
117    if (not defined $ENV{'PBTAG'}) {
118        if ((defined $pkgt) && (defined $pkgt->{$proj})) {
119            $ENV{'PBTAG'}=$pkgt->{$proj};
120        } else {
121            die "No projtag found in $ENV{'PBCONF'}/$proj.pb";
122        }
123    }
124    die "Invalid tag name $ENV{'PBTAG'} in $ENV{'PBCONF'}/$proj.pb" if ($ENV{'PBTAG'} !~ /[0-9.]+/);
125} else {
126    die "Unable to open $ENV{'PBCONF'}/$proj.pb";
127}
128
129#
130# Set temp directory
131#
132if (not defined $ENV{'TMPDIR'}) {
133    $ENV{'TMPDIR'}="/tmp";
134}
135$ENV{'PBTMP'} = tempdir( "pb.XXXXXXXXXX", DIR => $ENV{'TMPDIR'}, CLEANUP => 1 );
136
137#
138# Removes all directory existing below the delivery dir
139# as they are temp dir only
140# Files stay and have to be cleaned up manually
141#
142if (-d $ENV{'PBDESTDIR'}) {
143    opendir(DIR,$ENV{'PBDESTDIR'}) || die "Unable to open directory $ENV{'PBDESTDIR'}: $!";
144    foreach my $d (readdir(DIR)) {
145        next if ($d =~ /^\./);
146        next if (-f "$ENV{'PBDESTDIR'}/$d");
147        pb_rm_rf("$ENV{'PBDESTDIR'}/$d") if (-d "$ENV{'PBDESTDIR'}/$d");
148    }
149    closedir(DIR);
150}
151if (! -d "$ENV{'PBDESTDIR'}") {
152    pb_mkdir_p($ENV{'PBDESTDIR'}) || die "Unable to recursively create $ENV{'PBDESTDIR'}";
153}
154
155#
156# Set build directory
157#
158$ENV{'PBBUILDDIR'}=$topdir."/build";
159if (! -d "$ENV{'PBBUILDDIR'}") {
160    pb_mkdir_p($ENV{'PBBUILDDIR'}) || die "Unable to recursively create $ENV{'PBBUILDDIR'}";
161}
162
163umask 0022;
164return($proj,$debug,$LOG,\%pbrc, \%filteredfiles, \%defpkgdir, \%extpkgdir);
165}
166
167# Internal mkdir -p function
168sub pb_mkdir_p {
169my @dir = @_;
170my $ret = mkpath(@dir, 0, 0755);
171return($ret);
172}
173
174# Internal rm -rf function
175sub pb_rm_rf {
176my @dir = @_;
177my $ret = rmtree(@dir, 0, 0);
178return($ret);
179}
180
181# Internal system function
182sub pb_system {
183
184my $cmd=shift;
185my $cmt=shift || $cmd;
186
187print $LOG "$cmt... ";
188system("$cmd 2>&1 > $ENV{'PBTMP'}/system.log");
189if ($? == -1) {
190    print $LOG "failed to execute ($cmd) : $!\n" if ($debug >= 0);
191    pb_display_file("$ENV{'PBTMP'}/system.log");
192} elsif ($? & 127) {
193    printf $LOG "child ($cmd) died with signal %d, %s coredump\n", ($? & 127),  ($? & 128) ? 'with' : 'without' if ($debug >= 0);
194    pb_display_file("$ENV{'PBTMP'}/system.log");
195} elsif ($? == 0) {
196    print $LOG "OK\n" if ($debug >= 0);
197} else {
198    printf "child ($cmd) exited with value %d\n", $? >> 8;
199    pb_display_file("$ENV{'PBTMP'}/system.log");
200}
201}
202
203sub pb_display_file {
204
205my $file=shift;
206
207open(FILE,"$file") || die "Unable to open $file";
208while (<FILE>) {
209    print $LOG;
210}
211close(FILE);
212}
213
214# Function which returns a pointer on a hash
215# corresponding to a declaration (arg2) in the main conf file
216# and test the returned vaue as they need to exist in that case
217sub pb_conf_get {
218
219my @param = @_;
220
221my @ptr = pb_conf_read("$ENV{'PBETC'}", @param);
222
223foreach my $i (0..$#param) {
224    die "No $param[$i] defined for $ENV{'PBPROJ'}" if (not defined $ptr[$i]);
225    my $p = $ptr[$i];
226    $p->{$ENV{'PBPROJ'}} = $p->{'default'} if (not defined $p->{$ENV{'PBPROJ'}});
227    die "No $param[$i] defined for $ENV{'PBPROJ'}" if (not defined $p->{$ENV{'PBPROJ'}});
228}
229print "DEBUG: param: ".Dumper(@ptr)."\n" if ($debug >= 1);
230return(@ptr);
231}
232
233# Function which returns a pointer on a hash
234# corresponding to a declaration (arg2) in a conf file (arg1)
235sub pb_conf_read {
236
237my $conffile = shift;
238my @param = @_;
239my $trace;
240my @ptr;
241
242if ($debug > 0) {
243    $trace = 1;
244} else {
245    $trace = 0;
246}
247
248
249my $config = AppConfig->new({
250                            # Auto Create variables mentioned in Conf file
251                            CREATE => 1,
252                            DEBUG => $trace,
253                            GLOBAL => {
254                                # Each conf item is a hash
255                                ARGCOUNT => ARGCOUNT_HASH,
256                            },
257                        });
258$config->file($conffile);
259for my $param (@param) {
260    push @ptr,$config->get($param);
261}
262print "DEBUG: params: ".Dumper(@param)." ".Dumper(@ptr)."\n" if ($debug >= 1);
263return(@ptr);
264}
265
266# Setup environment for CMS system
267sub pb_cms_init {
268
269my $proj = shift || undef;
270my $ret;
271
272my ($cms) = pb_conf_get("cms");
273# This one is optional
274my ($cvsroot) = pb_conf_read($ENV{'PBETC'},"cvsroot");
275
276if ($cms->{$proj} eq "svn") {
277    $ENV{'PBREVISION'}=`(cd "$ENV{'PBROOT'}" ; svnversion .)`;
278    chomp($ENV{'PBREVISION'});
279    $ENV{'PBCMSLOG'}="svn log";
280    $ENV{'PBCMSLOGFILE'}="svn.log";
281} elsif ($cms->{$proj} eq "cvs") {
282    # Way too slow
283    #$ENV{'PBREVISION'}=`(cd "$ENV{'PBROOT'}" ; cvs rannotate  -f . 2>&1 | awk '{print \$1}' | grep -E '^[0-9]' | cut -d. -f2 |sort -nu | tail -1)`;
284    #chomp($ENV{'PBREVISION'});
285    $ENV{'PBREVISION'}="CVS";
286    $ENV{'PBCMSLOG'}="cvs log";
287    $ENV{'PBCMSLOGFILE'}="cvs.log";
288    #
289    # Export content if needed
290    #
291    $ENV{'CVSROOT'} = $cvsroot->{$proj} if (defined $cvsroot->{$proj});
292} else {
293    die "cms $cms->{$proj} unknown";
294}
295return($cms);
296}
297
298sub pb_cms_export {
299my $cms = shift;
300my $pbdate = shift || undef;
301my $pkgdir = shift;
302my $destdir = shift;
303
304if ($cms->{$ENV{'PBPROJ'}} eq "svn") {
305    pb_system("svn export $pkgdir $destdir","Exporting $pkgdir from SVN");
306} elsif ($cms->{$ENV{'PBPROJ'}} eq "cvs") {
307    my $dir=dirname($destdir);
308    my $base=basename($destdir);
309    my $tmp=basename($pkgdir);
310    # CVS needs a relative path !
311    pb_system("cd $dir ; cvs export -D $pbdate -d $base $tmp","Exporting $pkgdir from CVS");
312} else {
313    die "cms $cms->{$ENV{'PBPROJ'}} unknown";
314}
315}
316
317sub pb_cms_log {
318my $cms = shift;
319my $pkgdir = shift;
320my $destfile = shift;
321
322if ($cms->{$ENV{'PBPROJ'}} eq "svn") {
323    pb_system("svn log $pkgdir > $destfile","Extracting log info from SVN");
324} elsif ($cms->{$ENV{'PBPROJ'}} eq "cvs") {
325    my $tmp=basename($pkgdir);
326    # CVS needs a relative path !
327    pb_system("cvs log $tmp > $destfile","Extracting log info from CVS");
328} else {
329    die "cms $cms->{$ENV{'PBPROJ'}} unknown";
330}
331}
332   
333
334
335# Get all filters to apply
336# They're cumulative from less specific to most specific
337# suffix is .pbf
338
339sub pb_get_filters {
340
341my @ffiles;
342my ($ffile0, $ffile1, $ffile2, $ffile3);
343my $pbpkg = shift || die "No package specified";
344my $dtype = shift || die "No dtype specified";
345my $dfam = shift || die "No dfam specified";
346my $ddir = shift || die "No ddir specified";
347my $dver = shift || die "No dver specified";
348my $ptr; # returned value pointer on the hash of filters
349my %ptr;
350
351if (-d "$ENV{'PBCONF'}/$pbpkg/pbfilter") {
352    $ffile0 = "$ENV{'PBCONF'}/$pbpkg/pbfilter/$dtype.pbf" if (-f "$ENV{'PBCONF'}/$pbpkg/pbfilter/$dtype.pbf");
353    $ffile1 = "$ENV{'PBCONF'}/$pbpkg/pbfilter/$dfam.pbf" if (-f "$ENV{'PBCONF'}/$pbpkg/pbfilter/$dfam.pbf");
354    $ffile2 = "$ENV{'PBCONF'}/$pbpkg/pbfilter/$ddir.pbf" if (-f "$ENV{'PBCONF'}/$pbpkg/pbfilter/$ddir.pbf");
355    $ffile3 = "$ENV{'PBCONF'}/$pbpkg/pbfilter/$ddir-$dver.pbf" if (-f "$ENV{'PBCONF'}/$pbpkg/pbfilter/$ddir-$dver.pbf");
356
357    push @ffiles,$ffile0 if (defined $ffile0);
358    push @ffiles,$ffile1 if (defined $ffile1);
359    push @ffiles,$ffile2 if (defined $ffile2);
360    push @ffiles,$ffile3 if (defined $ffile3);
361}
362if (@ffiles) {
363    print $LOG "DEBUG ffiles: ".Dumper(\@ffiles)."\n" if ($debug >= 1);
364
365    my $config = AppConfig->new({
366        # Auto Create variables mentioned in Conf file
367        CREATE => 1,
368        DEBUG => 0,
369        GLOBAL => {
370            # Each conf item is a hash
371            ARGCOUNT => AppConfig::ARGCOUNT_HASH
372        }
373    });
374
375    $config->file(@ffiles);
376    $ptr = $config->get("filter");
377    print $LOG "DEBUG f:".Dumper($ptr)."\n" if ($debug >= 1);
378} else {
379    $ptr = { };
380}
381%ptr = %$ptr;
382return(\%ptr);
383}
384
385# Function which applies filter on files (only for pb)
386sub pb_filter_file_pb {
387
388my $f=shift;
389my $ptr=shift;
390my %filter=%$ptr;
391my $destfile=shift;
392my $dtype=shift;
393my $pbsuf=shift;
394my $pbpkg=shift;
395my $pbver=shift;
396my $pbtag=shift;
397my $pbrev=shift;
398my $pbdate=shift;
399
400print $LOG "DEBUG: From $f to $destfile\n" if ($debug >= 1);
401pb_mkdir_p(dirname($destfile)) if (! -d dirname($destfile));
402open(DEST,"> $destfile") || die "Unable to create $destfile";
403open(FILE,"$f") || die "Unable to open $f: $!";
404while (<FILE>) {
405    my $line = $_;
406    foreach my $s (keys %filter) {
407        # Process single variables
408        print $LOG "DEBUG filter{$s}: $filter{$s}\n" if ($debug >= 1);
409        my $tmp = $filter{$s};
410        next if (not defined $tmp);
411        # Expand variables if any single one found
412        print $LOG "DEBUG tmp: $tmp\n" if ($debug >= 1);
413        if ($tmp =~ /\$/) {
414            eval { $tmp =~ s/(\$\w+)/$1/eeg };
415        # special case for ChangeLog only for pb
416        } elsif (($tmp =~ /^yes$/) && ($s =~ /^PBLOG$/) && ($line =~ /^PBLOG$/)) {
417            $tmp = "";
418            my $p = $defpkgdir{$pbpkg};
419            $p = $extpkgdir{$pbpkg} if (not defined $p);
420            pb_changelog($dtype, $pbpkg, $pbtag, $pbsuf, $p, \*DEST);
421        }
422        $line =~ s|$s|$tmp|;
423    }
424    print DEST $line;
425}
426close(FILE);
427close(DEST);
428}
429
430# Function which applies filter on files (external call)
431sub pb_filter_file {
432
433my $f=shift;
434my $ptr=shift;
435my %filter=%$ptr;
436my $destfile=shift;
437my $pbsuf=shift;
438my $pbpkg=shift;
439my $pbver=shift;
440my $pbtag=shift;
441my $pbrev=shift;
442my $pbdate=shift;
443
444print $LOG "DEBUG: From $f to $destfile\n" if ($debug >= 1);
445pb_mkdir_p(dirname($destfile)) if (! -d dirname($destfile));
446open(DEST,"> $destfile") || die "Unable to create $destfile";
447open(FILE,"$f") || die "Unable to open $f: $!";
448while (<FILE>) {
449    my $line = $_;
450    foreach my $s (keys %filter) {
451        # Process single variables
452        print $LOG "DEBUG filter{$s}: $filter{$s}\n" if ($debug > 1);
453        my $tmp = $filter{$s};
454        next if (not defined $tmp);
455        # Expand variables if any single one found
456        if ($tmp =~ /\$/) {
457            eval { $tmp =~ s/(\$\w+)/$1/eeg };
458        }
459        $line =~ s|$s|$tmp|;
460    }
461    print DEST $line;
462}
463close(FILE);
464close(DEST);
465}
466
467
4681;
Note: See TracBrowser for help on using the repository browser.