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

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

Better src printing

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