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

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

Lots of debug traces. Looking for a bug in AppConfig where for hash a key of 1 is added without defined value.
Except that, weems to work just fine (content to be checked)
  • Property svn:executable set to *
File size: 9.4 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);
24%extpkgdir = ();
25%filteredfiles = ();
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('p:t',\%opts);
45
46# Handles project name if any
47if (defined $opts{'p'}) {
48 $ENV{'PBPROJ'} = env_init($opts{'p'});
49} else {
50 $ENV{'PBPROJ'} = env_init();
51}
52# Handles test option
53if (defined $opts{'t'}) {
54 $test = "TRUE";
55 # Works only for SVN
56 $option = "-r BASE";
57}
58
59# Get Action
60$action = shift @ARGV;
61die "Syntax: pb [-p project] <action> [<params>...]" if (not defined $action);
62
63print "Project $ENV{'PBPROJ'}\n";
64#print "Action: $action - ARGV:".Dumper(\@ARGV);
65
66# Act depending on action
67if ($action =~ /^cms2build$/) {
68 print "Action: cms2build\n";
69 # Get packages list
70 if (not defined $ARGV[0]) {
71 @pkgs = keys %defpkgdir;
72 } elsif ($ARGV[0] =~ /^all$/) {
73 @pkgs = keys %defpkgdir;
74 if (defined %extpkgdir) {
75 my $k = keys %extpkgdir;
76 if (defined $k) {
77 push(@pkgs, keys %extpkgdir);
78 }
79 }
80 } else {
81 @pkgs = @ARGV;
82 }
83 print "Packages:\n";
84 print Dumper(@pkgs);
85 cms_init();
86
87 foreach my $pkg (@pkgs) {
88
89 if (-f "$ENV{'PBROOT'}/$pkg/VERSION") {
90 open(V,"$ENV{'PBROOT'}/$pkg/VERSION") || die "Unable to open $ENV{'PBROOT'}/$pkg/VERSION";
91 $pbver = <V>;
92 chomp($pbver);
93 close(V);
94 } else {
95 $pbver = $ENV{'PBVER'};
96 }
97
98 if (-f "$ENV{'PBROOT'}/$pkg/TAG") {
99 open(T,"$ENV{'PBROOT'}/$pkg/TAG") || die "Unable to open $ENV{'PBROOT'}/$pkg/TAG";
100 $pbtag = <T>;
101 chomp($pbtag);
102 close(T);
103 } else {
104 $pbtag = $ENV{'PBTAG'};
105 }
106 $pbrev = $ENV{'PBREVISION'};
107 print "Management of $pkg $pbver-$pbtag (rev $pbrev)\n";
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 "$ENV{'PBCMSEXP'} of $pkg...";
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 "failed to execute: $!\n";
123 } elsif ($? & 127) {
124 printf "child died with signal %d, %s coredump\n", ($? & 127), ($? & 128) ? 'with' : 'without';
125 } else {
126 print " Done under $dest\n";
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 "$ENV{'PBCMSLOG'} of $pkg...";
137 if ($? == -1) {
138 print "failed to execute: $!\n";
139 } elsif ($? & 127) {
140 printf "child died with signal %d, %s coredump\n", ($? & 127), ($? & 128) ? 'with' : 'without';
141 } else {
142 print " OK\n";
143 }
144 open(D,"$ENV{'PBCONF'}/DISTROS") || die "Unable to find $ENV{'PBCONF'}/DISTROS\n";
145 while (<D>) {
146 my $d = $_;
147 my ($dir,$ver) = split(/_/,$d);
148 chomp($ver);
149 print "Generating build files for $dir ($ver)\n";
150 my ($ddir, $dver, $dfam, $dtype, $dsuf) = distro_init($dir,$ver);
151 #print Dumper($ddir, $dver, $dfam, $dtype, $dsuf);
152 #print "Filtering DDD => $pbdate, TTT => $pbtag, RRR => $pbtag$dsuf, VVV => $pbver\n";
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 "dir: $ENV{'PBCONF'}/$pkg\n";
160 if (-d "$ENV{'PBCONF'}/$pkg/$dtype") {
161 opendir(BDIR,"$ENV{'PBCONF'}/$pkg/$dtype" || die "Unable to open dir $ENV{'PBCONF'}/$pkg/$dtype: $!");
162 foreach my $f (readdir(BDIR)) {
163 next if ($f =~ /^\./);
164 $bfiles{$f} = "$ENV{'PBCONF'}/$pkg/$dtype/$f";
165 $bfiles{$f} =~ s~$ENV{'PBROOT'}~~;
166 }
167 closedir(BDIR);
168 } elsif (-d "$ENV{'PBCONF'}/$pkg/$dfam") {
169 opendir(BDIR,"$ENV{'PBCONF'}/$pkg/$dfam" || die "Unable to open dir $ENV{'PBCONF'}/$pkg/$dfam: $!");
170 foreach my $f (readdir(BDIR)) {
171 next if ($f =~ /^\./);
172 $bfiles{$f} = "$ENV{'PBCONF'}/$pkg/$dfam/$f";
173 $bfiles{$f} =~ s~$ENV{'PBROOT'}~~;
174 }
175 closedir(BDIR);
176 } elsif (-d "$ENV{'PBCONF'}/$pkg/$ddir") {
177 opendir(BDIR,"$ENV{'PBCONF'}/$pkg/$ddir" || die "Unable to open dir $ENV{'PBCONF'}/$pkg/$ddir: $!");
178 foreach my $f (readdir(BDIR)) {
179 next if ($f =~ /^\./);
180 $bfiles{$f} = "$ENV{'PBCONF'}/$pkg/$ddir/$f";
181 $bfiles{$f} =~ s~$ENV{'PBROOT'}~~;
182 }
183 closedir(BDIR);
184 } elsif (-d "$ENV{'PBCONF'}/$pkg/$ddir-$dver") {
185 opendir(BDIR,"$ENV{'PBCONF'}/$pkg/$ddir-$dver" || die "Unable to open dir $ENV{'PBCONF'}/$pkg/$ddir-$dver: $!");
186 foreach my $f (readdir(BDIR)) {
187 next if ($f =~ /^\./);
188 $bfiles{$f} = "$ENV{'PBCONF'}/$pkg/$ddir-$dver/$f";
189 $bfiles{$f} =~ s~$ENV{'PBROOT'}~~;
190 }
191 closedir(BDIR);
192 } else {
193 print "No Build Files found for $ddir-$dver\n";
194 next;
195 }
196 print "bfiles: ".Dumper(\%bfiles)."\n";
197
198 # Get all filters to apply
199 # They're cumulative from less specific to most specific
200 # suffix is .pbf
201 my @ffiles;
202 my ($ffile0, $ffile1, $ffile2, $ffile3);
203 if (-d "$ENV{'PBCONF'}/$pkg/pbfilter") {
204 $ffile0 = "$ENV{'PBCONF'}/$pkg/pbfilter/$dtype.pbf" if (-f "$ENV{'PBCONF'}/$pkg/pbfilter/$dtype.pbf");
205 $ffile1 = "$ENV{'PBCONF'}/$pkg/pbfilter/$dfam.pbf" if (-f "$ENV{'PBCONF'}/$pkg/pbfilter/$dfam.pbf");
206 $ffile2 = "$ENV{'PBCONF'}/$pkg/pbfilter/$ddir.pbf" if (-f "$ENV{'PBCONF'}/$pkg/pbfilter/$ddir.pbf");
207 $ffile3 = "$ENV{'PBCONF'}/$pkg/pbfilter/$ddir-$dver.pbf" if (-f "$ENV{'PBCONF'}/$pkg/pbfilter/$ddir-$dver.pbf");
208 push @ffiles,$ffile0 if (defined $ffile0);
209 push @ffiles,$ffile1 if (defined $ffile1);
210 push @ffiles,$ffile2 if (defined $ffile2);
211 push @ffiles,$ffile3 if (defined $ffile3);
212 }
213 my $config = AppConfig->new({
214 # Auto Create variables mentioned in Conf file
215 CREATE => 1,
216 DEBUG => 0,
217 GLOBAL => {
218 # Each conf item is a hash
219 ARGCOUNT => AppConfig::ARGCOUNT_HASH
220 }
221 });
222 my $ptr;
223 if (@ffiles) {
224 print "ffiles: ".Dumper(\@ffiles)."\n";
225 $config->file(@ffiles);
226 $ptr = $config->get("filter");
227 print "f:".Dumper($ptr)."\n";
228 } else {
229 $ptr = { };
230 }
231
232 # Apply now all the filters on all the files concerned
233 # All files are relative to PBROOT
234 # destination dir depends on the type of file
235 if (defined $ptr) {
236 foreach my $f (values %bfiles) {
237 filter_file($f,$ptr,"$dest/pbconf/$ddir-$dver/".basename($f),$pkg,$dtype,$dsuf);
238 }
239 foreach my $f (keys %filteredfiles) {
240 filter_file($f,$ptr,"$dest/$f",$pkg,$dtype,$dsuf);
241 }
242 }
243 }
244 close(D);
245 # Prepare the dest directory for archive
246 if (-x "$ENV{'PBCONF'}/$pkg/pbpkginit") {
247 system("cd $dest ; $ENV{'PBCONF'}/$pkg/pbinit");
248 if ($? == -1) {
249 print "failed to execute: $!\n";
250 } elsif ($? & 127) {
251 printf "child died with signal %d, %s coredump\n", ($? & 127), ($? & 128) ? 'with' : 'without';
252 } else {
253 print " $dest\n";
254 }
255 }
256 # Archive dest dir
257 chdir "$dest/..";
258 print "Creating $pkg tar files (gzip... ";
259 system("tar cfphz $pkg-$pbver.tar.gz $pkg-$pbver");
260 if ($? == -1) {
261 print "failed to execute: $!\n";
262 } elsif ($? & 127) {
263 printf "child died with signal %d, %s coredump\n", ($? & 127), ($? & 128) ? 'with' : 'without';
264 } else {
265 print " OK)\n";
266 print "Under $dest/../$pkg-$pbver.tar.gz\n";
267 }
268 }
269} else {
270 print "'$action' is not available\n";
271 print "Available actions are:\n";
272 print " cms2build\n";
273}
274
275# Function which applies filter on files
276sub filter_file {
277
278my $f=shift;
279my $ptr=shift;
280my %filter=%$ptr;
281my $destfile=shift;
282my $pkg=shift;
283my $dtype=shift;
284my $dsuf=shift;
285
286print "From $f to $destfile\n";
287pbmkdir_p(dirname($destfile)) if (! -d dirname($destfile));
288open(DEST,"> $destfile") || die "Unable to create $destfile";
289open(FILE,"$ENV{'PBROOT'}/$f") || die "Unable to open $f: $!";
290while (<FILE>) {
291 my $line = $_;
292 foreach my $s (keys %filter) {
293 # Process single variables
294 #print "debug: $filter{$s}\n";
295 my $tmp = $filter{$s};
296 next if (not defined $tmp);
297 # Expand variables if any single one found
298 if ($tmp =~ /\$/) {
299 eval { $tmp =~ s/(\$\w+)/$1/eeg };
300 # special case for ChangeLog
301 } elsif (($tmp =~ /^yes$/) && ($s =~ /^PBLOG$/)) {
302 my $p = $defpkgdir{$pkg};
303 $p = $extpkgdir{$pkg} if (not defined $p);
304 $tmp = changelog($dtype, $pkg, $pbtag, $dsuf, $p, \*DEST);
305 }
306 $line =~ s|$s|$tmp|;
307 }
308 print DEST $line;
309}
310close(FILE);
311close(DEST);
312}
Note: See TracBrowser for help on using the repository browser.