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