atoms_cc/buildtoolbox:

 * add logging functions (common_log, common_enter_stage, common_leave_stage, common_die, common_exec)
 * check DESCRIPTION-FUNCTIONS file
 * 'check' stage (hopefully) done... have to check on windows, though :(

1 files changed, 201 insertions, 33 deletions

diff --git a/atoms_cc/buildtoolbox.pl b/atoms_cc/buildtoolbox.pl
index 770636d..fa5d36d 100755
--- a/atoms_cc/buildtoolbox.pl
+++ b/atoms_cc/buildtoolbox.pl
@@ -7,7 +7,91 @@ use strict;
 use Cwd;
 
 my ($TOOLBOXFILE, # Toolbox archive to compile
-    $TOOLBOXNAME); # Name of the toolbox
+    $TOOLBOXNAME, # Name of the toolbox
+        $STAGE); # Current stage
+
+# common_log:
+#    Print a log message. Seconf argument is the type of the
+#    message:
+#     " " for a normal message
+#     "!" for an error
+#     ">" when starting a stage
+#     "<" when terminating a stage
+#     "$" when running a command
+#     "?" for the return code of previous command
+sub common_log {
+        my $message = shift;
+        my $type = shift || " ";
+        
+        # Check message format: any newline must start by a space,
+        # no new line at end of message
+        $message =~ s/(?<=\n)(?!\s|$)/ /g;
+        chomp $message;
+        
+        print LOGFILE "[".time()."]${type}${message}\n";
+}
+
+# common_enter_stage:
+#    Common stuff while starting a new stage
+sub common_enter_stage {
+        $STAGE = shift;
+        common_log($STAGE, ">");
+}
+
+# common_leave_stage:
+#    Common stuff while ending new stage
+sub common_leave_stage {
+        common_log($STAGE, "<");
+}
+
+# common_die:
+#    Called when a problem happens
+sub common_die {
+        my $message = shift;
+        common_log($message, "!");
+        common_leave_stage();
+        
+        while(wait() > 0) { };
+        close LOGFILE;
+        exit(1);
+}
+
+# common_exec:
+#    Execute given command, places its outputs to log files.
+#    Returns a file handle on STDOUT
+#    Die if return code is non-zero
+sub common_exec {
+        my $cmd = shift;
+        my $commandnum = 1;
+        
+        # Find commandnum: log files are (stage)-1.out for first
+        # command of (stage), (stage)-2.out for second command of stage,
+        # and so on
+        $commandnum++ while(-e "$STAGE-$commandnum.out");
+        
+        my $stdout = "$STAGE-$commandnum.out";
+        my $stderr = "$STAGE-$commandnum.err";
+        
+        common_log("$cmd\nstdout=$stdout\nstderr=$stderr", "\$");
+        
+        my $pid = fork();
+        if($pid == 0) {
+                open STDOUT, ">$stdout";
+                open STDERR, ">$stderr";
+                exec $cmd;
+        }
+        else {
+                waitpid($pid, 0);
+                common_log("$?", "?");
+                if($? != 0) {
+                        common_die("\"$cmd\" failed");
+                }
+        }
+        
+        open my ($fd), $stdout;
+        
+        return $fd;
+}
 
 # is_zip:
 #    Return true if toolbox file extension is zip
@@ -20,7 +104,7 @@ sub is_zip {
 sub get_tree_from_tgz {
         my %files;
         
-        open my $fd, "tar -tzf ${TOOLBOXFILE}|";
+        my $fd = common_exec("tar -tzf ${TOOLBOXFILE}");
         
         while(<$fd>) {
                 chomp;
@@ -37,11 +121,11 @@ sub get_tree_from_zip {
         my (%files, $line);
         
         # tail & head are here to skip header & footer
-        open my $fd, "unzip -l ${TOOLBOXFILE} | tail -n +4 | head -n -2 |";
+        my $fd = common_exec("unzip -l ${TOOLBOXFILE} | tail -n +4 | head -n -2");
         
         while(<$fd>) {
                 # zip output format: size date time filename
-                /\s*\d+\s+\d+-\d+-\d+\s+\d+:\d+\s+(.+)/ or die "Bad output of unzip";
+                /\s*\d+\s+\d+-\d+-\d+\s+\d+:\d+\s+(.+)/ or common_die "Bad output of unzip";
                 chomp $1;
                 $files{$1} = 1;
         }
@@ -62,28 +146,28 @@ sub get_tree {
         }
 }
 
-# get_description_from_tgz:
-#    Extract DESCRIPTION file from the archive (in tar.gz format)
-sub get_description_from_tgz {
-        open my $fd, "tar -xOzf ${TOOLBOXFILE} ${TOOLBOXNAME}/DESCRIPTION |";
-        return $fd;
+# read_file_from_tgz:
+#    Extract given file from the .zip archive
+sub read_file_from_tgz {
+        my $filename = shift;
+        return common_exec("tar -xOzf ${TOOLBOXFILE} ${TOOLBOXNAME}/$filename");
 }
 
-# get_description_from_tgz:
-#    Extract DESCRIPTION file from the archive (in zip format)
-sub get_description_from_zip {
-        open my $fd, "unzip -c ${TOOLBOXFILE} ${TOOLBOXNAME}/DESCRIPTION | tail -n +3 | head -n -1 |";
-        return $fd;
+# read_file_from_tgz:
+#    Extract given file from the .tar.gz archive
+sub read_file_from_zip {
+        my $filename = shift;
+        return common_exec("unzip -c ${TOOLBOXFILE} ${TOOLBOXNAME}/$filename | tail -n +3 | head -n -1");
 }
 
-# get_description:
-#   Extract DESCRIPTION file from the archive
-sub get_description {
-        if(is_zip) {
-                return get_description_from_zip();
+# read_file_from_archive:
+#   Extract given file from the archive
+sub read_file_from_archive {
+        if(is_zip()) {
+                return read_file_from_zip(@_);
         }
         else {
-                return get_description_from_tgz();
+                return read_file_from_tgz(@_);
         }
 }
 
@@ -93,7 +177,7 @@ sub get_description {
 #   First argument is a file descriptor for the DESCRIPTION file (see
 #   get_description)
 sub read_description {
-        my ($fd) = shift;
+        my $fd = shift;
         my @required = qw(Toolbox Version Title Author Maintainer
                           Description License Category);
         my @optional = qw(Date Depends URL Entity);
@@ -102,7 +186,7 @@ sub read_description {
         
         # Populate hash
         while(<$fd>) {
-                die "\":\" not followed by a space at line $." if(/:(?! )/);
+                common_die "\":\" not followed by a space at line $." if(/:(?! )/);
                 if(/:/) { # New field
                         ($key, $val) = split(/: /, $_, 2);
                         $infos{$key} = $val;
@@ -117,7 +201,7 @@ sub read_description {
         # Check presence of required fields, mark them as correct
         foreach (@required) {
                 if(!defined($infos{$_})) {
-                        die "Mandatory field \"$_\" not defined";
+                        common_die "Mandatory field \"$_\" not defined";
                 }
                 else {
                         $correct{$_} = 1;
@@ -134,7 +218,7 @@ sub read_description {
         # Check that there's no incorrect (= unknown) fields
         foreach (keys(%infos)) {
                 if($correct{$_} == 0) {
-                        die "Unknown field \"$_\" (defined at line $lines{$_})";
+                        common_die "Unknown field \"$_\" (defined at line $lines{$_})";
                 }
         }
         
@@ -142,6 +226,33 @@ sub read_description {
         return %infos;
 }
 
+# read_description_functions:
+#   Parse DESCRIPTION-FUNCTIONS file (and check it, too). Like DESCRIPTION,
+#   first argument is a file descriptor. Returns a hash function name =>
+#   function description
+sub read_description_functions {
+        my $fd = shift;
+        my (%funcs, $func, $desc);
+        
+        while(<$fd>) {
+                if(/-/ && !/ - /) {
+                        common_die "\"-\" not surrounded by spaces at line $.";
+                }
+                
+                if(/-/) { # New field
+                        ($func, $desc) = split(/ - /, $_, 2);
+                        $funcs{$func} = $desc;
+                }
+                else { # Previous function description continuation
+                        $funcs{$func} .= $_;
+                }
+        }
+        
+        chomp %funcs;
+        
+        return %funcs;
+}
+
 # check_tree:
 #   Given a source tree of a toolbox (see get_tree), check if it is correct
 #   (required files are present, files are at their right place, and so on...)
@@ -156,7 +267,7 @@ sub check_tree {
                         $newtree{$_} = 1 if $_;
                 }
                 else {
-                        die "Incorrect archive: \"$_\" is not a child of \"$TOOLBOXNAME\"";
+                        common_die "Incorrect archive: \"$_\" is not a child of \"$TOOLBOXNAME\"";
                 }
         }
         %tree = %newtree;
@@ -169,14 +280,14 @@ sub check_tree {
         
         foreach (@required) {
                 if(!defined($tree{$_})) {
-                        die "Incorrect archive: required file \"$_\" not present";
+                        common_die "Incorrect archive: required file \"$_\" not present";
                 }
         }
         
         # macros/ must contain only .sci and .sce files
         foreach (grep { $_ =~ m#^macros/# } keys %tree) {
                 if(!/(\.sc[ie]|\/)$/) {
-                        die "Incorrect archive: macros/ must contain only .sci and .sce files".
+                        common_die "Incorrect archive: macros/ must contain only .sci and .sce files".
                             " (\"$_\" found)";
                 }
         }
@@ -184,7 +295,7 @@ sub check_tree {
         # All fortran files must be in src/fortran
         foreach (grep { $_ =~ /\.f$/} keys %tree) {
                 if(!m#^src/fortran/#) {
-                        die "Incorrect archive: \"$_\" is a fortran source and hence has to be in ".
+                        common_die "Incorrect archive: \"$_\" is a fortran source and hence has to be in ".
                             "src/fortran";
                 }
         }
@@ -192,7 +303,7 @@ sub check_tree {
         # All c files must be in src/c or sci_gateway/{c,fortran}
         foreach (grep { $_ =~ /\.[ch]$/} keys %tree) {
                 if(!m#^(src/c|sci_gateway/(c|fortran))/#) {
-                        die "Incorrect archive: \"$_\" is a C source and hence has to be in ".
+                        common_die "Incorrect archive: \"$_\" is a C source and hence has to be in ".
                             "src/c, sci_gateway/c or sci_gateway/fortran";
                 }
         }
@@ -227,23 +338,80 @@ sub check_tree {
                 my $required = $constraints{$constraint};
                 my @found = grep { $_ =~ $constraint } keys %tree;
                 if(@found && !defined($tree{$required})) {
-                        die "Invalid archive: \"$found[0]\" needs \"$required\", which isn't in the archive";
+                        common_die "Invalid archive: \"$found[0]\" needs \"$required\", which isn't in the archive";
                 }
         }
 }
 
+# stage_check:
+#   Perform basic checks
+sub stage_check {
+        common_enter_stage("check");
+        
+        if(is_zip()) {
+                common_log("Detected ZIP format");
+        }
+        else {
+                common_log("Detected TAR+GZIP format");
+        }
+        
+        # Check tree
+        common_log("Checking archive structure");
+        my %tree = get_tree();
+        common_log("Archive files:\n" . join("\n", sort keys %tree));
+        check_tree(%tree);
+        
+        # Check DESCRIPTION
+        common_log("Checking DESCRIPTION");
+        my $fd = read_file_from_archive("DESCRIPTION");
+        my %desc = read_description($fd);
+        common_log("Computed DESCRIPTION:\n" .
+                join("\n", map { "$_: $desc{$_}" } sort keys %desc));
+        
+        # Check toolbox name
+        if($TOOLBOXNAME ne $desc{"Toolbox"}) {
+                common_die "Detected toolbox name ($TOOLBOXNAME) different from ".
+                    "DESCRIPTION version ($desc{Toolbox})";
+        }
+        
+        # Check version
+        my $version = $1 if ($TOOLBOXFILE =~ /[^.]+\.([^-]+)/);
+        if(!defined($version)) {
+                common_die "Can't detect version from archive name ($TOOLBOXFILE)";
+        }
+        
+        if($version ne $desc{"Version"}) {
+                common_die "Detected version ($version) different from DESCRIPTION ".
+                    "version ($desc{Version})";
+        }
+        
+        # Check DESCRIPTION-FUNCTIONS
+        common_log("Checking DESCRIPTION-FUNCTIONS");
+        $fd = read_file_from_archive("DESCRIPTION-FUNCTIONS");
+        my %funcs = read_description_functions($fd);
+        common_log("Computed DESCRIPTION-FUNCTIONS:\n" .
+                join("\n", map { "$_: $funcs{$_}" } sort keys %funcs));
+        
+        common_leave_stage("check");
+}
+
 # Init global vars, check arguments
 $TOOLBOXFILE = shift;
 if(!defined($TOOLBOXFILE)) {
-        die "Toolbox source file required";
+        common_die "Toolbox source file required";
 }
 
 if(! -r $TOOLBOXFILE) {
-        die "$TOOLBOXFILE doesn't exists or can't be read";
+        common_die "$TOOLBOXFILE doesn't exists or can't be read";
 }
 
 $TOOLBOXNAME = $1 if ($TOOLBOXFILE =~ /^([^.]+)/);
 
+open LOGFILE, ">build.log";
+
+common_log "Toolbox: $TOOLBOXNAME";
+common_log "Source file: $TOOLBOXFILE";
 
-check_tree(get_tree());
+stage_check;
 
+close LOGFILE;