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

Last change on this file since 23 was 23, checked in by Bruno Cornec, 17 years ago

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