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

Last change on this file since 21 was 21, checked in by Bruno Cornec, 17 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.