source: devel/pb/bin/pb.pl @ 21

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

Add syntax, control of traces, debug level ...
Much Nicer output now

  • Property svn:executable set to *
File size: 10.9 KB
Line 
1#!/usr/bin/perl -w
2#
3# Project Builder main application
4#
5# $Id$
6#
7# Copyright B. Cornec 2007
8# Provided under the GPL v2
9
10# Syntax: pb [-p project] <action> [<params>...]
11
12use strict 'vars';
13use Switch;
14use Getopt::Std;
15use Data::Dumper;
16use English;
17use AppConfig qw(:argcount :expand);
18use File::Basename;
19use Archive::Tar;
20use Time::localtime qw(localtime);
21use POSIX qw(strftime);
22
23use vars qw (%defpkgdir %extpkgdir %version %confparam %filteredfiles $debug);
24%extpkgdir = ();
25%filteredfiles = ();
26$debug = 0;                 # Debug level
27use lib qw (lib);
28use common qw (env_init);
29use pb qw (pb_init);
30use distro qw (distro_init);
31use cms;
32use changelog qw (changelog);
33
34my %opts;                   # CLI Options
35my $action;                 # action to realize
36my $test = "FALSE";
37my $option = "";
38my @pkgs;
39my $pbtag;                  # Global TAG variable
40my $pbver;                  # Global VERSION variable
41my $pbrev;                  # GLOBAL REVISION variable
42my @date=(localtime->sec(), localtime->min(), localtime->hour(), localtime->mday(), localtime->mon(), localtime->year(), localtime->wday(), localtime->yday(), localtime->isdst());
43my $pbdate = strftime("%Y-%m-%d", @date);
44
45getopts('hp:qtv',\%opts);
46
47if (defined $opts{'h'}) {
48    syntax();
49    exit(0);
50}
51if (defined $opts{'v'}) {
52    $debug++;
53}
54if (defined $opts{'q'}) {
55    $debug=-1;
56}
57# Handles project name if any
58if (defined $opts{'p'}) {
59    $ENV{'PBPROJ'} = env_init($opts{'p'});
60} else {
61    $ENV{'PBPROJ'} = env_init();
62}
63# Handles test option
64if (defined $opts{'t'}) {
65    $test = "TRUE";
66    # Works only for SVN
67    $option = "-r BASE";
68}
69
70# Get Action
71$action = shift @ARGV;
72die syntax() if (not defined $action);
73
74print "Project $ENV{'PBPROJ'}\n" if ($debug >= 0);
75print "Action: $action\n" if ($debug >= 0);
76
77# Act depending on action
78if ($action =~ /^cms2build$/) {
79    # Get packages list
80    if (not defined $ARGV[0]) {
81        @pkgs = keys %defpkgdir;
82    } elsif ($ARGV[0] =~ /^all$/) {
83        @pkgs = keys %defpkgdir;
84        if (defined %extpkgdir) {
85            my $k = keys %extpkgdir;
86            if (defined $k) {
87                push(@pkgs, keys %extpkgdir);
88            }
89        }
90    } else {
91        @pkgs = @ARGV;
92    }
93    print "Packages: ".join(',',@pkgs)."\n" if ($debug >= 0);
94    cms_init();
95
96    foreach my $pkg (@pkgs) {
97
98        if (-f "$ENV{'PBROOT'}/$pkg/VERSION") {
99            open(V,"$ENV{'PBROOT'}/$pkg/VERSION") || die "Unable to open $ENV{'PBROOT'}/$pkg/VERSION";
100            $pbver = <V>;
101            chomp($pbver);
102            close(V);
103        } else {
104            $pbver = $ENV{'PBVER'};
105        }
106
107        if (-f "$ENV{'PBROOT'}/$pkg/TAG") {
108            open(T,"$ENV{'PBROOT'}/$pkg/TAG") || die "Unable to open $ENV{'PBROOT'}/$pkg/TAG";
109            $pbtag = <T>;
110            chomp($pbtag);
111            close(T);
112        } else {
113            $pbtag = $ENV{'PBTAG'};
114        }
115        $pbrev = $ENV{'PBREVISION'};
116        print "\n" if ($debug >= 0);
117        print "Management of $pkg $pbver-$pbtag (rev $pbrev)\n" if ($debug >= 0);
118        die "Unable to get env var PBDESTDIR" if (not defined $ENV{'PBDESTDIR'});
119        # Clean up dest if necessary. The export will recreate it
120        my $dest = "$ENV{'PBDESTDIR'}/$pkg-$pbver";
121        pbrm_rf($dest) if (-d $dest);
122
123        # Export CMS tree for the concerned package to dest
124        # And generate some additional files
125        $OUTPUT_AUTOFLUSH=1;
126        print "$ENV{'PBCMSEXP'} of $pkg..." if ($debug >= 0);
127        # computes in which dir we have to work
128        my $dir = $defpkgdir{$pkg};
129        $dir = $extpkgdir{$pkg} if (not defined $dir);
130        system("$ENV{'PBCMSEXP'} $option $ENV{'PBROOT'}/$dir $dest 1>/dev/null");
131        if ($? == -1) {
132            print "failed to execute: $!\n" if ($debug >= 0);
133        } elsif ($? & 127) {
134            printf "child died with signal %d, %s coredump\n", ($? & 127),  ($? & 128) ? 'with' : 'without' if ($debug >= 0);
135        } else {
136            print " OK\n" if ($debug >= 0);
137        }
138
139        # Creates a REVISION file
140        open(R,"> $dest/REVISION") || die "Unable to create $dest/REVISION";
141        print R "$pbrev\n";
142        close(R);
143
144        # Extract cms log history and store it
145        system("$ENV{'PBCMSLOG'} $option $ENV{'PBROOT'}/$dir > $dest/$ENV{'PBCMSLOGFILE'}");
146        print "$ENV{'PBCMSLOG'} of $pkg..." if ($debug >= 0);
147        if ($? == -1) {
148            print "failed to execute: $!\n" if ($debug >= 0);
149        } elsif ($? & 127) {
150            printf "child died with signal %d, %s coredump\n", ($? & 127),  ($? & 128) ? 'with' : 'without' if ($debug >= 0);
151        } else {
152            print " OK\n" if ($debug >= 0);
153        }
154        my %build;
155        open(D,"$ENV{'PBCONF'}/DISTROS") || die "Unable to find $ENV{'PBCONF'}/DISTROS\n";
156        while (<D>) {
157            my $d = $_;
158            my ($dir,$ver) = split(/_/,$d);
159            chomp($ver);
160            my ($ddir, $dver, $dfam, $dtype, $dsuf) = distro_init($dir,$ver);
161            print "DEBUG: distro tuple: ".Dumper($ddir, $dver, $dfam, $dtype, $dsuf)."\n" if ($debug >= 1);
162            print "DEBUG Filtering PBDATE => $pbdate, PBTAG => $pbtag, PBVER => $pbver\n" if ($debug >= 1);
163
164            # Filter build files from the less precise up to the most with overloading
165            # Filter all files found, keeping the name, and generating in dest
166
167            # Find all build files first relatively to PBROOT
168            my %bfiles;
169            print "DEBUG dir: $ENV{'PBCONF'}/$pkg\n" if ($debug >= 1);
170            $build{"$ddir-$dver"} = "yes";
171            if (-d "$ENV{'PBCONF'}/$pkg/$dtype") {
172                opendir(BDIR,"$ENV{'PBCONF'}/$pkg/$dtype" || die "Unable to open dir $ENV{'PBCONF'}/$pkg/$dtype: $!");
173                foreach my $f (readdir(BDIR)) {
174                    next if ($f =~ /^\./);
175                    $bfiles{$f} = "$ENV{'PBCONF'}/$pkg/$dtype/$f";
176                    $bfiles{$f} =~ s~$ENV{'PBROOT'}~~;
177                }
178                closedir(BDIR);
179            } elsif (-d "$ENV{'PBCONF'}/$pkg/$dfam") {
180                opendir(BDIR,"$ENV{'PBCONF'}/$pkg/$dfam" || die "Unable to open dir $ENV{'PBCONF'}/$pkg/$dfam: $!");
181                foreach my $f (readdir(BDIR)) {
182                    next if ($f =~ /^\./);
183                    $bfiles{$f} = "$ENV{'PBCONF'}/$pkg/$dfam/$f";
184                    $bfiles{$f} =~ s~$ENV{'PBROOT'}~~;
185                }
186                closedir(BDIR);
187            } elsif (-d "$ENV{'PBCONF'}/$pkg/$ddir") {
188                opendir(BDIR,"$ENV{'PBCONF'}/$pkg/$ddir" || die "Unable to open dir $ENV{'PBCONF'}/$pkg/$ddir: $!");
189                foreach my $f (readdir(BDIR)) {
190                    next if ($f =~ /^\./);
191                    $bfiles{$f} = "$ENV{'PBCONF'}/$pkg/$ddir/$f";
192                    $bfiles{$f} =~ s~$ENV{'PBROOT'}~~;
193                }
194                closedir(BDIR);
195            } elsif (-d "$ENV{'PBCONF'}/$pkg/$ddir-$dver") {
196                opendir(BDIR,"$ENV{'PBCONF'}/$pkg/$ddir-$dver" || die "Unable to open dir $ENV{'PBCONF'}/$pkg/$ddir-$dver: $!");
197                foreach my $f (readdir(BDIR)) {
198                    next if ($f =~ /^\./);
199                    $bfiles{$f} = "$ENV{'PBCONF'}/$pkg/$ddir-$dver/$f";
200                    $bfiles{$f} =~ s~$ENV{'PBROOT'}~~;
201                }
202                closedir(BDIR);
203            } else {
204                $build{"$ddir-$dver"} = "no";
205                next;
206            }
207            print "DEBUG bfiles: ".Dumper(\%bfiles)."\n" if ($debug >= 1);
208
209            # Get all filters to apply
210            # They're cumulative from less specific to most specific
211            # suffix is .pbf
212            my @ffiles;
213            my ($ffile0, $ffile1, $ffile2, $ffile3);
214            if (-d "$ENV{'PBCONF'}/$pkg/pbfilter") {
215                $ffile0 = "$ENV{'PBCONF'}/$pkg/pbfilter/$dtype.pbf" if (-f "$ENV{'PBCONF'}/$pkg/pbfilter/$dtype.pbf");
216                $ffile1 = "$ENV{'PBCONF'}/$pkg/pbfilter/$dfam.pbf" if (-f "$ENV{'PBCONF'}/$pkg/pbfilter/$dfam.pbf");
217                $ffile2 = "$ENV{'PBCONF'}/$pkg/pbfilter/$ddir.pbf" if (-f "$ENV{'PBCONF'}/$pkg/pbfilter/$ddir.pbf");
218                $ffile3 = "$ENV{'PBCONF'}/$pkg/pbfilter/$ddir-$dver.pbf" if (-f "$ENV{'PBCONF'}/$pkg/pbfilter/$ddir-$dver.pbf");
219                push @ffiles,$ffile0 if (defined $ffile0);
220                push @ffiles,$ffile1 if (defined $ffile1);
221                push @ffiles,$ffile2 if (defined $ffile2);
222                push @ffiles,$ffile3 if (defined $ffile3);
223            }
224            my $config = AppConfig->new({
225                            # Auto Create variables mentioned in Conf file
226                            CREATE => 1,
227                            DEBUG => 0,
228                            GLOBAL => {
229                                # Each conf item is a hash
230                                ARGCOUNT => AppConfig::ARGCOUNT_HASH
231                            }
232                        });
233            my $ptr;
234            if (@ffiles) {
235                print "DEBUG ffiles: ".Dumper(\@ffiles)."\n" if ($debug >= 1);
236                $config->file(@ffiles);
237                $ptr = $config->get("filter");
238                print "DEBUG f:".Dumper($ptr)."\n" if ($debug >= 1);
239            } else {
240                $ptr = { };
241            }
242
243            # Apply now all the filters on all the files concerned
244            # All files are relative to PBROOT
245            # destination dir depends on the type of file
246            if (defined $ptr) {
247                foreach my $f (values %bfiles) {
248                    filter_file($f,$ptr,"$dest/pbconf/$ddir-$dver/".basename($f),$pkg,$dtype,$dsuf);
249                }
250                foreach my $f (keys %filteredfiles) {
251                    filter_file($f,$ptr,"$dest/$f",$pkg,$dtype,$dsuf);
252                }
253            }
254        }
255        if ($debug >= 0) {
256            my @found;
257            my @notfound;
258            foreach my $b (keys %build) {
259                push @found,$b if ($build{$b} =~ /yes/);
260                push @notfound,$b if ($build{$b} =~ /no/);
261            }
262            print "Build files generated for ".join(',',@found)."\n";
263            print "No Build files found for ".join(',',@notfound)."\n";
264        }
265        close(D);
266        # Prepare the dest directory for archive
267        if (-x "$ENV{'PBCONF'}/$pkg/pbpkginit") {
268            system("cd $dest ; $ENV{'PBCONF'}/$pkg/pbinit");
269            if ($? == -1) {
270                print "failed to execute: $!\n" if ($debug >= 0);
271            } elsif ($? & 127) {
272                printf "child died with signal %d, %s coredump\n", ($? & 127),  ($? & 128) ? 'with' : 'without' if ($debug >= 0);
273            } else {
274                print " $dest\n" if ($debug >= 0);
275            }
276        }
277        # Archive dest dir
278        chdir "$dest/..";
279        print "Creating $pkg tar files (gzip... " if ($debug >= 0);
280        system("tar cfphz $pkg-$pbver.tar.gz $pkg-$pbver");
281        if ($? == -1) {
282            print "failed to execute: $!\n" if ($debug >= 0);
283        } elsif ($? & 127) {
284            printf "child died with signal %d, %s coredump\n", ($? & 127),  ($? & 128) ? 'with' : 'without' if ($debug >= 0);
285        } else {
286            print " OK)\n" if ($debug >= 0);
287            print "Under $dest/../$pkg-$pbver.tar.gz\n" if ($debug >= 0);
288        }
289    }
290} else {
291    print "'$action' is not available\n";
292    syntax();
293}
294
295# Function which applies filter on files
296sub filter_file {
297
298my $f=shift;
299my $ptr=shift;
300my %filter=%$ptr;
301my $destfile=shift;
302my $pkg=shift;
303my $dtype=shift;
304my $dsuf=shift;
305
306print "DEBUG: From $f to $destfile\n" if ($debug >= 1);
307pbmkdir_p(dirname($destfile)) if (! -d dirname($destfile));
308open(DEST,"> $destfile") || die "Unable to create $destfile";
309open(FILE,"$ENV{'PBROOT'}/$f") || die "Unable to open $f: $!";
310while (<FILE>) {
311    my $line = $_;
312    foreach my $s (keys %filter) {
313        # Process single variables
314        print "DEBUG filter{$s}: $filter{$s}\n" if ($debug > 1);
315        my $tmp = $filter{$s};
316        next if (not defined $tmp);
317        # Expand variables if any single one found
318        if ($tmp =~ /\$/) {
319            eval { $tmp =~ s/(\$\w+)/$1/eeg };
320        # special case for ChangeLog
321        } elsif (($tmp =~ /^yes$/) && ($s =~ /^PBLOG$/) && ($line =~ /^PBLOG$/)) {
322            my $p = $defpkgdir{$pkg};
323            $p = $extpkgdir{$pkg} if (not defined $p);
324            changelog($dtype, $pkg, $pbtag, $dsuf, $p, \*DEST);
325            $tmp = "";
326        }
327        $line =~ s|$s|$tmp|;
328    }
329    print DEST $line;
330}
331close(FILE);
332close(DEST);
333}
334
335sub syntax {
336
337    print "Syntax: pb [-vhqt][-p project] <action> [<params>...]\n";
338    print "\n";
339    print "-h : This help file\n";
340    print "-q : Quiet mode\n";
341    print "-t : Test mode (not done yet)\n";
342    print "-v : Verbose mode\n";
343    print "\n";
344    print "-p project : Name of the project you're working on\n";
345    print "             (or use the env variable PBPROJ)     \n";
346    print "\n";
347    print "<action> can be:\n";
348    print "\n";
349    print "\tcms2build: Create a tar file of the project under your CMS\n";
350    print "\t           CMS supported are SVN and CVS\n";
351    print "\n";
352    print "\tbuild2pkg: Create packages for your running distribution  \n";
353    print "\n";
354    print "\n";
355}
Note: See TracBrowser for help on using the repository browser.