Release note of the 5.2.X updated
[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 # Save standard I/O for common_exec
14 open OLD_STDOUT, ">&STDOUT";
15 open OLD_STDERR, ">&STDERR";
16 open OLD_STDIN, "<&STDIN";
17
18 # common_log(message, type):
19 #    Print a log message. Second argument is the type of the
20 #    message:
21 #     " " for a normal message
22 #     "!" for an error
23 #     ">" when starting a stage
24 #     "<" when terminating a stage
25 #     "$" when running a command
26 #     "?" for the return code of previous command
27 sub common_log {
28         my $message = shift;
29         my $type = shift || " ";
30         
31         # Check message format: any newline must start by a space,
32         # no new line at end of message
33         $message =~ s/(?<=\n)(?!\s|$)/ /g;
34         chomp $message;
35         
36         print LOGFILE "[".time()."]${type}${message}\n";
37         print "[$type] $message \n";
38 }
39
40 # common_enter_stage(stage):
41 #    Common stuff while starting a new stage
42 sub common_enter_stage {
43         $STAGE = shift;
44         common_log($STAGE, ">");
45 }
46
47 # common_leave_stage:
48 #    Common stuff while ending new stage
49 sub common_leave_stage {
50         common_log($STAGE, "<");
51 }
52
53 # common_die(message):
54 #    Called when a problem happens
55 sub common_die {
56         my $message = shift;
57         common_log($message, "!");
58         common_leave_stage();
59         
60         while(wait() > 0) { };
61         close LOGFILE;
62         exit(1);
63 }
64
65 # common_exec(command, args..., [opts]):
66 #    Execute given command, places its outputs to log files. If last argument
67 #    is a reference to a hash, it's considered as options for the function.
68 #    Right now, only one option is available, "stderr_to_stdout", which do the
69 #    same as 2>&1 in shell.
70 #    Returns a file handle on STDOUT.
71 #    Die if return code is non-zero or if standard error is non-empty.
72 sub common_exec {
73         # pretty_arg:
74         #     Human-readable form of the arguments array
75         sub pretty_arg {
76                 my $_ = shift;
77                 if(/\s|["']/) {
78                         s/"/\\"/g;
79                         s/^/"/;
80                         s/$/"/;
81                 }
82                 return $_;
83         }
84         
85         my $refopts = pop if ref($_[-1]) eq "HASH";
86         my %opts;
87            %opts = %$refopts if defined($refopts);
88         
89         my $cmd = join(" ", map { pretty_arg $_ } @_);
90         my $commandnum = 1;
91         
92         # Find commandnum: log files are (stage)-1.out for first
93         # command of (stage), (stage)-2.out for second command of stage,
94         # and so on
95         $commandnum++ while(-e "$STAGE-$commandnum.out");
96         
97         my $stdout = "$STAGE-$commandnum.out";
98         my $stderr = "$STAGE-$commandnum.err";
99         
100         common_log("$cmd\nstdout=$stdout\nstderr=$stderr", "\$");
101         
102         # Setup I/O for subprocess
103         open STDOUT, ">$stdout";
104         open STDERR, ">$stderr";
105         
106         if(defined($opts{"stderr_to_stdout"})) {
107                 close STDERR;
108                 open STDERR, ">&STDOUT";
109         }
110         
111         close STDIN;
112         
113         # Exec suprocess
114         system { $_[0] } @_;
115         
116         # Restore I/O
117         open STDIN, "<&OLD_STDIN";
118         open STDOUT, ">&OLD_STDOUT";
119         open STDERR, ">&OLD_STDERR";
120
121         common_log("$?", "?");
122         common_die("\"$cmd\" failed (non-zero exit code)") if($? != 0);
123         common_die("\"$cmd\" failed (non-empty error output)") if(-s $stderr);
124         
125         open my ($fd), $stdout;
126         
127         return $fd;
128 }
129
130 # common_exec_scilab(script):
131 #     Execute scilab script
132 sub common_exec_scilab {
133         my $script = shift;
134         $script = "try; $script; catch; write(%io(2), lasterror()); end; quit;";
135         
136         my $scilab = "scilex" if($^O =~ /mswin/i);
137            $scilab = "scilab" unless(defined($scilab));
138         
139         return common_exec($scilab, "-nwni", "-nb", "-e", $script);
140 }
141
142 # is_zip:
143 #    Return true if toolbox file extension is zip
144 sub is_zip {
145         return $TOOLBOXFILE =~ /\.zip$/;
146 }
147
148 # get_tree_from_tgz:
149 #   Get all files (names) of the compressed (in tar.gz) sources
150 sub get_tree_from_tgz {
151         my %files;
152         
153         my $fd = common_exec("tar", "-tf", $TOOLBOXFILE);
154         
155         while(<$fd>) {
156                 chomp;
157                 $files{$_} = 1;
158         }
159         
160         close $fd;
161         return %files;
162 }
163
164 # get_tree_from_zip:
165 #   Get all files (names) of the compressed (in zip) sources
166 sub get_tree_from_zip {
167         my (%files, $line);
168         
169         # tail & head are here to skip header & footer
170         my $fd = common_exec("unzip", "-l", $TOOLBOXFILE);
171         
172         while(<$fd>) {
173                 if(((/^\s*-+/)...(/^\s*-+/)) && !/^\s*-+/) { # Delete header & footer
174                         # zip output format: size date time filename
175                         /\s*\d+\s+\d+-\d+-\d+\s+\d+:\d+\s+(.+)/ or common_die "Bad output of unzip";
176                         chomp $1;
177                         $files{$1} = 1;
178                 }
179         }
180         
181         close $fd;
182         return %files;
183 }
184
185 # get_tree:
186 #   Get all files (names) of the compressed sources, in a hash
187 #   (hash values are meaningless, set to 1)
188 sub get_tree {
189         if(is_zip()) {
190                 return get_tree_from_zip();
191         }
192         else {
193                 return get_tree_from_tgz();
194         }
195 }
196
197 # read_file_from_tgz(filename):
198 #    Extract given file from the .zip archive
199 sub read_file_from_tgz {
200         my $filename = shift;
201         return common_exec("tar", "-xOf", $TOOLBOXFILE, "$TOOLBOXNAME/$filename");
202 }
203
204 # read_file_from_tgz(filename):
205 #    Extract given file from the .tar.gz archive
206 sub read_file_from_zip {
207         my $filename = shift;
208         return common_exec("unzip", "-p", $TOOLBOXFILE, "$TOOLBOXNAME/$filename");
209 }
210
211 # read_file_from_archive(filename):
212 #   Extract given file from the archive
213 sub read_file_from_archive {
214         if(is_zip()) {
215                 return read_file_from_zip(@_);
216         }
217         else {
218                 return read_file_from_tgz(@_);
219         }
220 }
221
222 # read_description(*description):
223 #   Check if DESCRIPTION file is correct, and parse it (return a hash
224 #   field => value).
225 #   First argument is a file descriptor for the DESCRIPTION file (see
226 #   get_description)
227 sub read_description {
228         my $fd = shift;
229         my @required = qw(Toolbox Version Title Author Maintainer License
230                           Description ScilabVersion Category);
231         my @optional = qw(Date Depends URL Entity);
232         my (%infos, $key, $val);
233         my (%lines, %correct);
234         
235         # Populate hash
236         while(<$fd>) {
237                 common_die "\":\" not followed by a space at line $." if(/:(?! )/);
238                 if(/:/) { # New field
239                         ($key, $val) = split(/: /, $_, 2);
240                         $infos{$key} = $val;
241                         $lines{$key} = $.;
242                         $correct{$key} = 0;
243                 }
244                 else { # Continuation of previous field
245                         $infos{$key} .= $_;
246                 }
247         }
248         
249         # Check presence of required fields, mark them as correct
250         foreach (@required) {
251                 if(!defined($infos{$_})) {
252                         common_die "Mandatory field \"$_\" not defined";
253                 }
254                 else {
255                         $correct{$_} = 1;
256                 }
257         }
258         
259         # Mark optional fields as correct
260         foreach (@optional) {
261                 if(defined($infos{$_})) {
262                         $correct{$_} = 1;
263                 }
264         }
265         
266         # Check that there's no incorrect (= unknown) fields
267         foreach (keys(%infos)) {
268                 if($correct{$_} == 0) {
269                         common_die "Unknown field \"$_\" (defined at line $lines{$_})";
270                 }
271         }
272         
273         chomp %infos;
274         return %infos;
275 }
276
277 # read_description_functions(*description_functions):
278 #   Parse DESCRIPTION-FUNCTIONS file (and check it, too). Like DESCRIPTION,
279 #   first argument is a file descriptor. Returns a hash function name =>
280 #   function description
281 sub read_description_functions {
282         my $fd = shift;
283         my (%funcs, $func, $desc);
284         
285         while(<$fd>) {
286                 if(/-/ && !/ - /) {
287                         common_die "\"-\" not surrounded by spaces at line $.";
288                 }
289                 
290                 if(/-/) { # New field
291                         ($func, $desc) = split(/ - /, $_, 2);
292                         $funcs{$func} = $desc;
293                 }
294                 else { # Previous function description continuation
295                         $funcs{$func} .= $_;
296                 }
297         }
298         
299         chomp %funcs;
300         
301         return %funcs;
302 }
303
304 # check_tree(%tree):
305 #   Given a source tree of a toolbox (see get_tree), check if it is correct
306 #   (required files are present, files are at their right place, and so on...)
307 sub check_tree {
308         my %tree = @_;
309         my %newtree;
310         
311         # Check that all files are under a root which has the same name as the toolbox
312         # Delete this root to simplify other tests
313         foreach (keys %tree) {
314                 if(s#^\Q$TOOLBOXNAME\E(/|$)##) {
315                         $newtree{$_} = 1 if $_;
316                 }
317                 else {
318                         common_die "Incorrect archive: \"$_\" is not a child of \"$TOOLBOXNAME\"";
319                 }
320         }
321         %tree = %newtree;
322         
323         # Check that basic files are here
324         my @required = qw(DESCRIPTION DESCRIPTION-FUNCTIONS readme.txt license.txt
325                           changelog.txt builder.sce);
326         push(@required, "etc/$TOOLBOXNAME.start");
327         push(@required, "etc/$TOOLBOXNAME.quit");
328         
329         foreach (@required) {
330                 if(!defined($tree{$_})) {
331                         common_die "Incorrect archive: required file \"$_\" not present";
332                 }
333         }
334         
335         # macros/ must contain only .sci and .sce files
336         foreach (grep { $_ =~ m#^macros/# } keys %tree) {
337                 if(!/(\.sc[ie]|\/)$/) {
338                         common_die "Incorrect archive: macros/ must contain only .sci and .sce files".
339                             " (\"$_\" found)";
340                 }
341         }
342         
343         # All fortran files must be in src/fortran
344         foreach (grep { $_ =~ /\.f$/} keys %tree) {
345                 if(!m#^src/fortran/#) {
346                         common_die "Incorrect archive: \"$_\" is a fortran source and hence has to be in ".
347                             "src/fortran";
348                 }
349         }
350
351         # All c files must be in src/c or sci_gateway/{c,fortran}
352         foreach (grep { $_ =~ /\.[ch]$/} keys %tree) {
353                 if(!m#^(src/c|sci_gateway/(c|fortran))/#) {
354                         common_die "Incorrect archive: \"$_\" is a C source and hence has to be in ".
355                             "src/c, sci_gateway/c or sci_gateway/fortran";
356                 }
357         }
358         
359         # Constraints: if $key exists, $constraints{$key} must exist
360         my %constraints = (
361                 qr#^help/([a-z][a-z]_[A-Z][A-Z])/[^/]+\.xml$# => sub{ "help/$1/build_help.sce" },
362                 qr#^help/([a-z][a-z]_[A-Z][A-Z])/build_help.sce$# => sub{ "help/$1/addchapter.sce" },
363                 qr#^help/([a-z][a-z]_[A-Z][A-Z])/addchapter.sce$# => sub{ "help/builder_help.sce" },
364                 qr#^sci_gateway/builder_gateway.sce$# => sub{ "sci_gateway/loader_gateway.sce" },
365                 qr#^macros/.+\.sc[ie]$# => sub{ "macros/buildmacros.sce" });
366         
367         # Build constraints for allowed languages
368         my %languages = (
369                 "c" => qr/[ch]/,
370                 "fortran" => qr/f/);
371         
372         foreach (keys %languages) {
373                 # if src/(lang) has source files, src/(lang)/builder_(lang).sce must exist
374                 $constraints{qr#^src/($_)/.+\.$languages{$_}$#} = sub{ "src/$1/builder_$1.sce" };
375                 
376                 # if sci_gateway/(lang) has C sources, sci_gateway/(lang)/builder_gateway_(lang).sce
377                 # must exist
378                 $constraints{qr#^sci_gateway/($_)/.+[ch]$#} = sub{ "sci_gateway/$1/builder_gateway_$1.sce" };
379                 
380                 # if src/(lang)/builder_(lang).sce exist, src/builder_src.sce must exist
381                 $constraints{qr#^src/$_/builder_$_.sce$#} = sub{ "src/builder_src.sce" };
382                 
383                 # if sci_gateway/(lang)/builder_gateway_(lang).sce exist, sci_gateway/builder_gateway.sce must exist
384                 $constraints{qr#^sci_gateway/$_/builder_gateway_$_.sce$#} = sub{ "sci_gateway/builder_gateway.sce" };
385         }
386         
387         # Check constraints
388         foreach my $constraint (keys %constraints) {
389                 foreach my $file (keys %tree) {
390                         if($file =~ $constraint) {
391                                 my $required = $constraints{$constraint}();
392                                 common_die "Invalid archive: \"$&\" needs \"$required\", which isn't in the archive"
393                                         unless(defined($tree{$required}));
394                         }
395                 }
396         }
397 }
398
399 # stage_check:
400 #   Perform basic checks
401 sub stage_check {
402         common_enter_stage("check");
403         
404         if(is_zip()) {
405                 common_log("Detected ZIP format");
406         }
407         else {
408                 common_log("Detected TAR+GZIP format");
409         }
410         
411         # Check tree
412         common_log("Checking archive structure");
413         my %tree = get_tree();
414         common_log("Archive files:\n" . join("\n", sort keys %tree));
415         check_tree(%tree);
416         
417         # Check DESCRIPTION
418         common_log("Checking DESCRIPTION");
419         my $fd = read_file_from_archive("DESCRIPTION");
420         my %desc = read_description($fd);
421         common_log("Computed DESCRIPTION:\n" .
422                 join("\n", map { "$_: $desc{$_}" } sort keys %desc));
423         
424         # Check toolbox name
425         if($TOOLBOXNAME ne $desc{"Toolbox"}) {
426                 common_die "Detected toolbox name ($TOOLBOXNAME) different from ".
427                     "DESCRIPTION version ($desc{Toolbox})";
428         }
429         
430         # Check version
431         my $version = $1 if ($TOOLBOXFILE =~ /[^.]+\.([^-]+)/);
432         if(!defined($version)) {
433                 common_die "Can't detect version from archive name ($TOOLBOXFILE)";
434         }
435         
436         if($version ne $desc{"Version"}) {
437                 common_die "Detected version ($version) different from DESCRIPTION ".
438                     "version ($desc{Version})";
439         }
440         
441         # Check DESCRIPTION-FUNCTIONS
442         common_log("Checking DESCRIPTION-FUNCTIONS");
443         $fd = read_file_from_archive("DESCRIPTION-FUNCTIONS");
444         my %funcs = read_description_functions($fd);
445         common_log("Computed DESCRIPTION-FUNCTIONS:\n" .
446                 join("\n", map { "$_: $funcs{$_}" } sort keys %funcs));
447         
448         common_leave_stage();
449 }
450
451 # stage_unpack:
452 #     Extract the archive
453 sub stage_unpack {
454         common_enter_stage("unpack");
455         
456         if(is_zip()) {
457                 common_exec("unzip", "-o", $TOOLBOXFILE);
458         }
459         else {
460                 common_exec("tar", "-xvf", $TOOLBOXFILE,
461                         {'stderr_to_stdout' => 1});
462         }
463         
464         common_leave_stage();
465 }
466
467 # stage_makeenv:
468 #    Build up the environment
469 sub stage_makeenv {
470         common_enter_stage("makeenv");
471         # TODO
472         common_leave_stage();
473 }
474
475 # compare_versions:
476 #    Returns -1 if version a < version b, 0 if equals, 1 else
477 sub compare_versions {
478         my $versa = shift;
479         my $versb = shift;
480         my @va = split(/\./, $versa);
481         my @vb = split(/\./, $versb);
482         
483         if($#va < $#vb) {
484                 return -compare_versions($versb, $versa);
485         }
486         
487         for(my $i = 0; $i < $#vb; ++$i) {
488                 return  1 if $va[$i] > $vb[$i];
489                 return -1 if $va[$i] < $vb[$i];
490         }
491         
492         return 1 if($#va > $#vb);
493         return 0;
494 }
495
496 # stage_tbdeps:
497 #    Install toolbox dependencies
498 sub stage_tbdeps {
499         my $fd;
500         my @depsarray;
501         my (%deps, %desc);
502         
503         common_enter_stage("tbdeps");
504         
505         # We alreay made the check, reading description should be OK
506         open $fd, "$TOOLBOXNAME/DESCRIPTION";
507         %desc = read_description($fd);
508         close($fd);
509         
510         # Make a hash depname => depvers
511         @depsarray = split(/\s*,\s*/, $desc{"Depends"} || "");
512         foreach (@depsarray) {
513                 if(/^(\S+?)\s*\(([<>]?=)\s*([^)]+)\)$/) { # toolbox-name (version-comparator version)
514                         $deps{$1} = "$2$3";
515                 }
516                 else {
517                         $deps{$_} = "*";
518                 }
519         }
520         
521         common_log("Dependencies: " . join(",", map { "$_ $deps{$_}" } keys %deps));
522         
523         # Install dependencies
524         close(common_exec_scilab("installToolbox('$_',1,'$deps{$_}')")) foreach(keys %deps);
525         
526         # Find toolboxes directory
527         $fd = common_exec_scilab("printf('path: %s\\n', cd(atomsToolboxDirectory()))");
528         
529         my $tbpath;
530         while(<$fd>) {
531                 if(/^path: (.+?)\r?$/) {
532                         $tbpath = $1;
533                         last;
534                 }
535         }
536         
537         if(!defined($tbpath)) {
538                 common_die("Can't find toolboxes directory");
539         }
540         
541         common_log("Toolboxes directory: $tbpath\n");
542         
543         # Check if required toolboxes are installed
544         foreach my $dep (keys %deps) {
545                 common_log("Checking $dep");
546                 if(! -r "$tbpath/$dep/DESCRIPTION") {
547                         common_die("Needed toolbox \"$dep\" is not installed");
548                 }
549                 
550                 next if($deps{$dep} eq "*");
551                 
552                 open $fd, "$tbpath/$dep/DESCRIPTION";
553                 my %desc2 = read_description($fd);
554                 close $fd;
555                 
556                 $deps{$dep} =~ /^([<>]?=)(.+)$/;
557                 
558                 # You can see this as "installed_version - required_version"
559                 my $cmp = compare_versions($desc2{"Version"}, $2);
560                 
561                 if($1 eq ">=" && $cmp == -1) { # <=> !($cmp >= 0) <=> !(installed >= required)
562                         common_die("We need \"$2\" >= $1, but version $desc2{Version} installed");
563                 }
564                 elsif($1 eq "=" && $cmp != 0) {
565                         common_die("We need \"$2\" == $1, but version $desc2{Version} installed");
566                 }
567                 elsif($cmp == 1) {  # <=> !($cmp <= 0) <=> !(installed <= required)
568                         common_die("We need \"$2\" <= $1, but version $desc2{Version} installed");
569                 }
570         }
571         
572         common_leave_stage();
573 }
574
575 # stage_sysdeps:
576 #    Install system dependencies
577 sub stage_sysdeps {
578         common_enter_stage("sysdeps");
579         # TODO
580         common_leave_stage();
581 }
582
583 # stage_build:
584 #     Run the build script
585 sub stage_build {
586         common_enter_stage("build");
587         
588         # Generate ccbuilder.sce (see __DATA__ section)
589         common_log("Generating ccbuilder.sce");
590         my $ccbuilder;
591         $ccbuilder .= $_ while(<DATA>);
592         open CCBUILDER, ">ccbuilder.sce";
593         print CCBUILDER $ccbuilder;
594         close CCBUILDER;
595         common_log("Generated ccbuilder.sce:\n$ccbuilder");
596         
597         # Run build script
598         common_log("Running ccbuilder.sce");
599         my $fd = common_exec_scilab("chdir('$TOOLBOXNAME'); exec('../ccbuilder.sce')");
600         
601         # Check result
602         common_log("Checking build result");
603         my $done = 0;
604         
605         while(<$fd>) {
606                 $done = 1 if(/^atoms_cc_builder:done\r?$/);
607                 if(/^atoms_cc_ilib_compile:\s*(.+?)\s*$/) {
608                         common_die("Generated library \"$1\" is invalid") unless($1 && ! -d $1 && (-x $1 || $^O =~ /win/i));
609                 }
610         }
611         
612         # fixme: need to check if everything was OK in macros/help generation
613         
614         common_die("builder.sce script didn't terminate normally") unless($done);
615         common_leave_stage();
616 }
617
618 # stage_pack:
619 #     Make the archive
620 sub stage_pack {
621         common_enter_stage("pack");
622         
623         my @files = qw(readme.txt license.txt changelog.txt DESCRIPTION-FUNCTIONS
624                 DESCRIPTION macros src help sci_gateway demos tests locales includes loader.sce);
625         push(@files, "etc/$TOOLBOXNAME.start");
626         push(@files, "etc/$TOOLBOXNAME.quit");
627         
628         my $output = $TOOLBOXFILE;
629         $output =~ s/(\.zip|\.tar.gz)$//;
630         $output .= "-bin";
631         
632         common_log("Making binary .tar.gz archive ($output.tar.gz)");
633         common_exec("tar", "-cvf", "$output.tar.gz", (map { "$TOOLBOXNAME/$_" } @files),
634                 {"stderr_to_stdout" => 1});
635         common_log("Making binary .zip archive ($output.zip)");
636         common_exec("zip", "-r", "$output.zip", map { "$TOOLBOXNAME/$_" } @files);
637         
638         common_leave_stage();
639 }
640
641 # stage_cleanenv:
642 #     Clean up the environment
643 sub stage_cleanenv {
644         common_enter_stage("cleanenv");
645         # TODO
646         common_leave_stage();
647 }
648
649 # Init global vars, check arguments
650 open LOGFILE, ">build.log";
651
652 $STAGE = "";
653
654 $TOOLBOXFILE = shift;
655 if(!defined($TOOLBOXFILE)) {
656         common_die "Toolbox source file required";
657 }
658
659 if(! -r $TOOLBOXFILE) {
660         common_die "$TOOLBOXFILE doesn't exists or can't be read";
661 }
662
663 $TOOLBOXNAME = $1 if ($TOOLBOXFILE =~ /^([^.]+)/);
664
665 common_log "Toolbox: $TOOLBOXNAME";
666 common_log "Source file: $TOOLBOXFILE";
667
668 stage_check;
669 stage_unpack;
670 stage_makeenv;
671 stage_tbdeps;
672 stage_sysdeps;
673 stage_build;
674 stage_pack;
675 stage_cleanenv;
676
677 close LOGFILE;
678 close OLD_STDERR;
679 close OLD_STDOUT;
680 close OLD_STDIN;
681
682 # Overwrite some scilab functions to get its return value and extra infos
683 __DATA__
684 predef(0);
685 funcprot(0);
686
687 old_ilib_compile = ilib_compile;
688 function libn = ilib_compile(lib_name,makename,files,ldflags,cflags,fflags)
689     libn = old_ilib_compile(lib_name,makename,files,ldflags,cflags,fflags);
690     mprintf("\natoms_cc_ilib_compile:%s/%s\n", pwd(), libn);
691 endfunction
692
693 exec("builder.sce");
694 mprintf("\natoms_cc_builder:done\n");
695