atoms_cc/buildtoolbox:
Simon Lipp [Thu, 26 Jun 2008 13:40:48 +0000 (13:40 +0000)]
 * 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 :(

atoms_cc/buildtoolbox.pl

index 770636d..fa5d36d 100755 (executable)
@@ -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;