d12dcc4aeabcf1eecf207e0a38ec234af87aad44
[scilab.git] / atoms_cc / buildtoolbox.pl
1 #!/usr/bin/perl -w
2
3 # buildtoolbox.pl
4 # Usage: buildtoolbox.pl toolbox-archive [config file [stage]]
5
6 use strict;
7 use Cwd;
8
9 my ($TOOLBOXFILE, # Toolbox archive to compile
10     $TOOLBOXNAME, # Name of the toolbox
11     $STAGE); # Current stage
12
13 # common_log:
14 #    Print a log message. Seconf argument is the type of the
15 #    message:
16 #     " " for a normal message
17 #     "!" for an error
18 #     ">" when starting a stage
19 #     "<" when terminating a stage
20 #     "$" when running a command
21 #     "?" for the return code of previous command
22 sub common_log {
23         my $message = shift;
24         my $type = shift || " ";
25         
26         # Check message format: any newline must start by a space,
27         # no new line at end of message
28         $message =~ s/(?<=\n)(?!\s|$)/ /g;
29         chomp $message;
30         
31         print LOGFILE "[".time()."]${type}${message}\n";
32         print "[$type] $message \n";
33 }
34
35 # common_enter_stage:
36 #    Common stuff while starting a new stage
37 sub common_enter_stage {
38         $STAGE = shift;
39         common_log($STAGE, ">");
40 }
41
42 # common_leave_stage:
43 #    Common stuff while ending new stage
44 sub common_leave_stage {
45         common_log($STAGE, "<");
46 }
47
48 # common_die:
49 #    Called when a problem happens
50 sub common_die {
51         my $message = shift;
52         common_log($message, "!");
53         common_leave_stage();
54         
55         while(wait() > 0) { };
56         close LOGFILE;
57         exit(1);
58 }
59
60 # common_exec:
61 #    Execute given command, places its outputs to log files.
62 #    Returns a file handle on STDOUT
63 #    Die if return code is non-zero
64 sub common_exec {
65         my $cmd = shift;
66         my $commandnum = 1;
67         
68         # Find commandnum: log files are (stage)-1.out for first
69         # command of (stage), (stage)-2.out for second command of stage,
70         # and so on
71         $commandnum++ while(-e "$STAGE-$commandnum.out");
72         
73         my $stdout = "$STAGE-$commandnum.out";
74         my $stderr = "$STAGE-$commandnum.err";
75         
76         common_log("$cmd\nstdout=$stdout\nstderr=$stderr", "\$");
77         
78         my $pid = fork();
79         if($pid == 0) {
80                 open STDOUT, ">$stdout";
81                 open STDERR, ">$stderr";
82                 close STDIN;
83                 exec $cmd;
84         }
85         else {
86                 waitpid($pid, 0);
87                 common_log("$?", "?");
88                 if($? != 0) {
89                         common_die("\"$cmd\" failed");
90                 }
91         }
92         
93         open my ($fd), $stdout;
94         
95         return $fd;
96 }
97
98 # is_zip:
99 #    Return true if toolbox file extension is zip
100 sub is_zip {
101         return $TOOLBOXFILE =~ /\.zip$/;
102 }
103
104 # get_tree_from_tgz:
105 #   Get all files (names) of the compressed (in tar.gz) sources
106 sub get_tree_from_tgz {
107         my %files;
108         
109         my $fd = common_exec("zcat ${TOOLBOXFILE} | tar -t");
110         
111         while(<$fd>) {
112                 chomp;
113                 $files{$_} = 1;
114         }
115         
116         close $fd;
117         return %files;
118 }
119
120 # get_tree_from_zip:
121 #   Get all files (names) of the compressed (in zip) sources
122 sub get_tree_from_zip {
123         my (%files, $line);
124         
125         # tail & head are here to skip header & footer
126         my $fd = common_exec("unzip -l ${TOOLBOXFILE}");
127         
128         while(<$fd>) {
129                 if(((/^\s*-+/)...(/^\s*-+/)) && !/^\s*-+/) { # Delete header & footer
130                         # zip output format: size date time filename
131                         /\s*\d+\s+\d+-\d+-\d+\s+\d+:\d+\s+(.+)/ or common_die "Bad output of unzip";
132                         chomp $1;
133                         $files{$1} = 1;
134                 }
135         }
136         
137         close $fd;
138         return %files;
139 }
140
141 # get_tree:
142 #   Get all files (names) of the compressed sources, in a hash
143 #   (hash values are meaningless, set to 1)
144 sub get_tree {
145         if(is_zip()) {
146                 return get_tree_from_zip();
147         }
148         else {
149                 return get_tree_from_tgz();
150         }
151 }
152
153 # read_file_from_tgz:
154 #    Extract given file from the .zip archive
155 sub read_file_from_tgz {
156         my $filename = shift;
157         return common_exec("zcat ${TOOLBOXFILE} | tar -xO ${TOOLBOXNAME}/$filename");
158 }
159
160 # read_file_from_tgz:
161 #    Extract given file from the .tar.gz archive
162 sub read_file_from_zip {
163         my $filename = shift;
164         return common_exec("unzip -p ${TOOLBOXFILE} ${TOOLBOXNAME}/$filename");
165 }
166
167 # read_file_from_archive:
168 #   Extract given file from the archive
169 sub read_file_from_archive {
170         if(is_zip()) {
171                 return read_file_from_zip(@_);
172         }
173         else {
174                 return read_file_from_tgz(@_);
175         }
176 }
177
178 # read_description:
179 #   Check if DESCRIPTION file is correct, and parse it (return a hash
180 #   field => value).
181 #   First argument is a file descriptor for the DESCRIPTION file (see
182 #   get_description)
183 sub read_description {
184         my $fd = shift;
185         my @required = qw(Toolbox Version Title Author Maintainer License
186                           Description ScilabVersion Category);
187         my @optional = qw(Date Depends URL Entity);
188         my (%infos, $key, $val);
189         my (%lines, %correct);
190         
191         # Populate hash
192         while(<$fd>) {
193                 common_die "\":\" not followed by a space at line $." if(/:(?! )/);
194                 if(/:/) { # New field
195                         ($key, $val) = split(/: /, $_, 2);
196                         $infos{$key} = $val;
197                         $lines{$key} = $.;
198                         $correct{$key} = 0;
199                 }
200                 else { # Continuation of previous field
201                         $infos{$key} .= $_;
202                 }
203         }
204         
205         # Check presence of required fields, mark them as correct
206         foreach (@required) {
207                 if(!defined($infos{$_})) {
208                         common_die "Mandatory field \"$_\" not defined";
209                 }
210                 else {
211                         $correct{$_} = 1;
212                 }
213         }
214         
215         # Mark optional fields as correct
216         foreach (@optional) {
217                 if(defined($infos{$_})) {
218                         $correct{$_} = 1;
219                 }
220         }
221         
222         # Check that there's no incorrect (= unknown) fields
223         foreach (keys(%infos)) {
224                 if($correct{$_} == 0) {
225                         common_die "Unknown field \"$_\" (defined at line $lines{$_})";
226                 }
227         }
228         
229         chomp %infos;
230         return %infos;
231 }
232
233 # read_description_functions:
234 #   Parse DESCRIPTION-FUNCTIONS file (and check it, too). Like DESCRIPTION,
235 #   first argument is a file descriptor. Returns a hash function name =>
236 #   function description
237 sub read_description_functions {
238         my $fd = shift;
239         my (%funcs, $func, $desc);
240         
241         while(<$fd>) {
242                 if(/-/ && !/ - /) {
243                         common_die "\"-\" not surrounded by spaces at line $.";
244                 }
245                 
246                 if(/-/) { # New field
247                         ($func, $desc) = split(/ - /, $_, 2);
248                         $funcs{$func} = $desc;
249                 }
250                 else { # Previous function description continuation
251                         $funcs{$func} .= $_;
252                 }
253         }
254         
255         chomp %funcs;
256         
257         return %funcs;
258 }
259
260 # check_tree:
261 #   Given a source tree of a toolbox (see get_tree), check if it is correct
262 #   (required files are present, files are at their right place, and so on...)
263 sub check_tree {
264         my %tree = @_;
265         my %newtree;
266         
267         # Check that all files are under a root which has the same name as the toolbox
268         # Delete this root to simplify other tests
269         foreach (keys %tree) {
270                 if(s#^\Q$TOOLBOXNAME\E(/|$)##) {
271                         $newtree{$_} = 1 if $_;
272                 }
273                 else {
274                         common_die "Incorrect archive: \"$_\" is not a child of \"$TOOLBOXNAME\"";
275                 }
276         }
277         %tree = %newtree;
278         
279         # Check that basic files are here
280         my @required = qw(DESCRIPTION DESCRIPTION-FUNCTIONS readme.txt license.txt
281                           builder.sce loader.sce);
282         push(@required, "etc/$TOOLBOXNAME.start");
283         push(@required, "etc/$TOOLBOXNAME.end");
284         
285         foreach (@required) {
286                 if(!defined($tree{$_})) {
287                         common_die "Incorrect archive: required file \"$_\" not present";
288                 }
289         }
290         
291         # macros/ must contain only .sci and .sce files
292         foreach (grep { $_ =~ m#^macros/# } keys %tree) {
293                 if(!/(\.sc[ie]|\/)$/) {
294                         common_die "Incorrect archive: macros/ must contain only .sci and .sce files".
295                             " (\"$_\" found)";
296                 }
297         }
298         
299         # All fortran files must be in src/fortran
300         foreach (grep { $_ =~ /\.f$/} keys %tree) {
301                 if(!m#^src/fortran/#) {
302                         common_die "Incorrect archive: \"$_\" is a fortran source and hence has to be in ".
303                             "src/fortran";
304                 }
305         }
306
307         # All c files must be in src/c or sci_gateway/{c,fortran}
308         foreach (grep { $_ =~ /\.[ch]$/} keys %tree) {
309                 if(!m#^(src/c|sci_gateway/(c|fortran))/#) {
310                         common_die "Incorrect archive: \"$_\" is a C source and hence has to be in ".
311                             "src/c, sci_gateway/c or sci_gateway/fortran";
312                 }
313         }
314         
315         # Constraints: if $key exists, $constraints{$key} must exist
316         my %constraints = (
317                 qr#help/.+\.xml$# => "help/buildhelp.sce",
318                 qr#macros/.+\.sc[ie]$# => "macros/buildmacros.sce");
319         
320         # Build constraints for allowed languages
321         my %languages = (
322                 "c" => qr/[ch]/,
323                 "fortran" => qr/f/);
324         
325         foreach (keys %languages) {
326                 # if src/(lang) has source files, src/(lang)/buildsrc_(lang).sce must exist
327                 $constraints{qr#^src/$_/.+\.$languages{$_}$#} = "src/$_/buildsrc_$_.sce";
328                 
329                 # if sci_gateway/(lang) has C sources, sci_gateway/(lang)/buildgateway_(lang).sce
330                 # must exist
331                 $constraints{qr#^sci_gateway/$_/.+[ch]$#} = "sci_gateway/$_/buildgateway_$_.sce";
332                 
333                 # if src/(lang)/buildsrc_(lang).sce exist, src/buildsrc.sce must exist
334                 $constraints{qr#^src/$_/buildsrc_$_.sce$#} = "src/buildsrc.sce";
335                 
336                 # if sci_gateway/(lang)/buildgateway_(lang).sce exist, sci_gateway/buildgateway.sce must exist
337                 $constraints{qr#^sci_gateway/$_/buildgateway_$_.sce$#} = "sci_gateway/buildgateway.sce";
338         }
339         
340         # Check constraints
341         foreach my $constraint (keys %constraints) {
342                 my $required = $constraints{$constraint};
343                 my @found = grep { $_ =~ $constraint } keys %tree;
344                 if(@found && !defined($tree{$required})) {
345                         common_die "Invalid archive: \"$found[0]\" needs \"$required\", which isn't in the archive";
346                 }
347         }
348 }
349
350 # stage_check:
351 #   Perform basic checks
352 sub stage_check {
353         common_enter_stage("check");
354         
355         if(is_zip()) {
356                 common_log("Detected ZIP format");
357         }
358         else {
359                 common_log("Detected TAR+GZIP format");
360         }
361         
362         # Check tree
363         common_log("Checking archive structure");
364         my %tree = get_tree();
365         common_log("Archive files:\n" . join("\n", sort keys %tree));
366         check_tree(%tree);
367         
368         # Check DESCRIPTION
369         common_log("Checking DESCRIPTION");
370         my $fd = read_file_from_archive("DESCRIPTION");
371         my %desc = read_description($fd);
372         common_log("Computed DESCRIPTION:\n" .
373                 join("\n", map { "$_: $desc{$_}" } sort keys %desc));
374         
375         # Check toolbox name
376         if($TOOLBOXNAME ne $desc{"Toolbox"}) {
377                 common_die "Detected toolbox name ($TOOLBOXNAME) different from ".
378                     "DESCRIPTION version ($desc{Toolbox})";
379         }
380         
381         # Check version
382         my $version = $1 if ($TOOLBOXFILE =~ /[^.]+\.([^-]+)/);
383         if(!defined($version)) {
384                 common_die "Can't detect version from archive name ($TOOLBOXFILE)";
385         }
386         
387         if($version ne $desc{"Version"}) {
388                 common_die "Detected version ($version) different from DESCRIPTION ".
389                     "version ($desc{Version})";
390         }
391         
392         # Check DESCRIPTION-FUNCTIONS
393         common_log("Checking DESCRIPTION-FUNCTIONS");
394         $fd = read_file_from_archive("DESCRIPTION-FUNCTIONS");
395         my %funcs = read_description_functions($fd);
396         common_log("Computed DESCRIPTION-FUNCTIONS:\n" .
397                 join("\n", map { "$_: $funcs{$_}" } sort keys %funcs));
398         
399         common_leave_stage("check");
400 }
401
402 # stage_unpack:
403 #     Extract the archive
404 sub stage_unpack {
405         common_enter_stage("unpack");
406         
407         if(is_zip()) {
408                 common_exec("unzip -o ${TOOLBOXFILE}");
409         }
410         else {
411                 common_exec("zcat ${TOOLBOXFILE} | tar -vx");
412         }
413         
414         common_leave_stage("unpack");
415 }
416
417 # stage_makeenv:
418 #    Build up the environment
419 sub stage_makeenv {
420         common_enter_stage("makeenv");
421         # TODO
422         common_leave_stage("makeenv");
423 }
424
425 # compare_versions:
426 #    Returns -1 if version a < version b, 0 if equals, 1 else
427 sub compare_versions {
428         my $versa = shift;
429         my $versb = shift;
430         my @va = split(/\./, $versa);
431         my @vb = split(/\./, $versb);
432         
433         if($#va < $#vb) {
434                 return -compare_versions($versb, $versa);
435         }
436         
437         for(my $i = 0; $i < $#vb; ++$i) {
438                 return  1 if $va[$i] > $vb[$i];
439                 return -1 if $va[$i] < $vb[$i];
440         }
441         
442         return 1 if($#va > $#vb);
443         return 0;
444 }
445
446 # stage_tbdeps:
447 #    Install toolbox dependencies
448 sub stage_tbdeps {
449         my $fd;
450         my @depsarray;
451         my (%deps, %desc);
452         
453         my $SCILABX = "scilab -nwni -nb -e ";
454         
455         common_enter_stage("tbdeps");
456         
457         # We alreay made the check, reading description should be OK
458         open $fd, "$TOOLBOXNAME/DESCRIPTION";
459         %desc = read_description($fd);
460         close($fd);
461         
462         # Make a hash depname => depvers
463         @depsarray = split(/\s*,\s*/, $desc{"Depends"} || "");
464         foreach (@depsarray) {
465                 if(/^(\S+?)\s*\([<>]=\s*([^)]+)\)$/) { # toolbox-name (version-comparator version)
466                         $deps{$1} = $2;
467                 }
468                 else {
469                         $deps{$_} = "*";
470                 }
471         }
472         
473         common_log("Dependencies: " . join(",", map { "$_ $deps{$_}" } keys %deps));
474         
475         # Install dependencies
476         # fixme: we always install the last version, but some packages
477         #   needs some versions... at most. Need to deal with that.
478         close(common_exec("$SCILABX 'installToolbox(\"$_\"); quit;'"))
479                 foreach(keys %deps);
480         
481         # Find toolboxes directory
482         $fd = common_exec("$SCILABX 'printf(\"path: %s\\n\", cd(toolboxDirectory())); quit;'");
483         
484         my $tbpath;
485         while(<$fd>) {
486                 if(/^path: (.+)$/) {
487                         $tbpath = $1;
488                         last;
489                 }
490         }
491         
492         if(!defined($tbpath)) {
493                 common_die("Can't find toolboxes directory");
494         }
495         
496         common_log("Toolboxes directory: $tbpath\n");
497         
498         # Check if required toolboxes are installed
499         foreach my $dep (keys %deps) {
500                 common_log("Checking $dep");
501                 if(! -r "$tbpath/$dep/DESCRIPTION") {
502                         common_die("Needed toolbox \"$dep\" is not installed");
503                 }
504                 
505                 next if($deps{$dep} eq "*");
506                 
507                 open $fd, "$tbpath/$dep/DESCRIPTION";
508                 my %desc2 = read_description($fd);
509                 close $fd;
510                 
511                 # fixme: we only check wether neededVersion <= installedVersion
512                 #   Others tests (=, <=) are still to be implemented
513                 if(compare_versions($deps{$dep}, $desc2{"Version"}) == 1) {
514                         common_die("We need \"$dep\" >= $deps{$dep}, but version $desc2{Version} installed");
515                 }
516         }
517         
518         common_leave_stage("tbdeps");
519 }
520
521 # Init global vars, check arguments
522 $TOOLBOXFILE = shift;
523 if(!defined($TOOLBOXFILE)) {
524         common_die "Toolbox source file required";
525 }
526
527 if(! -r $TOOLBOXFILE) {
528         common_die "$TOOLBOXFILE doesn't exists or can't be read";
529 }
530
531 $TOOLBOXNAME = $1 if ($TOOLBOXFILE =~ /^([^.]+)/);
532
533 open LOGFILE, ">build.log";
534
535 common_log "Toolbox: $TOOLBOXNAME";
536 common_log "Source file: $TOOLBOXFILE";
537
538 stage_check;
539 stage_unpack;
540 stage_makeenv;
541 stage_tbdeps;
542
543 close LOGFILE;