First version: checks DESCRIPTION file.

1 files changed, 195 insertions, 0 deletions

diff --git a/atoms_cc/buildtoolbox.pl b/atoms_cc/buildtoolbox.pl
new file mode 100755
index 0000000..8235597
--- /dev/null
+++ b/atoms_cc/buildtoolbox.pl
@@ -0,0 +1,195 @@
+#!/usr/bin/perl -w
+
+# buildtoolbox.pl
+# Usage: buildtoolbox.pl toolbox-archive [toolbox-name]
+
+use strict;
+use Cwd;
+
+my ($TOOLBOXFILE, # Toolbox archive to compile
+    $TOOLBOXNAME); # Name of the toolbox
+
+# is_zip:
+#    Return true if toolbox file extension is zip
+sub is_zip {
+        return $TOOLBOXFILE =~ /\.zip$/;
+}
+
+# get_tree_from_tgz:
+#   Get all files (names) of the compressed (in tar.gz) sources
+sub get_tree_from_tgz {
+        my (@files);
+        
+        open my $fd, "tar -tzf ${TOOLBOXFILE}|";
+        push(@files, $_) while <$fd>;
+        chomp(@files);
+        close $fd;
+        return @files;
+}
+
+# get_tree_from_zip:
+#   Get all files (names) of the compressed (in zip) sources
+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 |";
+        
+        while(<$fd>) {
+                # output format: size date time filename
+                /\s*\d+\s+\d+-\d+-\d+\s+\d+:\d+\s+(.+)/ or die "Bad output of unzip";
+                push(@files, $1);
+        }
+        
+        chomp(@files);
+        close $fd;
+        return @files;
+}
+
+# get_tree:
+#   Get all files (names) of the compressed sources
+sub get_tree {
+        if(is_zip()) {
+                return get_tree_from_zip();
+        }
+        else {
+                return get_tree_from_tgz();
+        }
+}
+
+# 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;
+}
+
+# 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;
+}
+
+# get_description:
+#   Extract DESCRIPTION file from the archive
+sub get_description {
+        if(is_zip) {
+                return get_description_from_zip();
+        }
+        else {
+                return get_description_from_tgz();
+        }
+}
+
+# read_description:
+#   Check if DESCRIPTION file is correct, and parse it (return a hash
+#   field => value).
+#   First argument is a file descriptor for the DESCRIPTION file (see
+#   get_description)
+sub read_description {
+        my ($fd) = shift;
+        my @required = qw(Toolbox Version Title Author Maintainer
+                          Description License Category);
+        my @optional = qw(Date Depends URL Entity);
+        my (%infos, $key, $val);
+        my (%lines, %correct);
+        
+        # Populate hash
+        while(<$fd>) {
+                die "\":\" not followed by a space at line $." if(/:(?! )/);
+                if(/:/) { # New field
+                        ($key, $val) = split(/: /, $_, 2);
+                        $infos{$key} = $val;
+                        $lines{$key} = $.;
+                        $correct{$key} = 0;
+                }
+                else { # Continuation of previous field
+                        $infos{$key} .= $_;
+                }
+        }
+        
+        # Check presence of required fields, mark them as correct
+        foreach (@required) {
+                if(!defined($infos{$_})) {
+                        die "Mandatory field \"$_\" not defined";
+                }
+                else {
+                        $correct{$_} = 1;
+                }
+        }
+        
+        # Mark optional fields as correct
+        foreach (@optional) {
+                if(defined($infos{$_})) {
+                        $correct{$_} = 1;
+                }
+        }
+        
+        # Check that there's no incorrect (= unknown) fields
+        foreach (keys(%infos)) {
+                if($correct{$_} == 0) {
+                        die "Unknown field \"$_\" (defined at line $lines{$_})";
+                }
+        }
+        
+        chomp %infos;
+        return %infos;
+}
+
+
+
+# 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...)
+sub check_tree {
+        #~ my @tree = shift;
+        #~ my %treehash;
+        
+        #~ print "$#tree\n";
+        foreach (@_) { print "=> $_ \n"; };
+        
+        #~ foreach (@tree) {
+                #~ # Make a hash from the tree (paths are keys, values are all to 1)
+                #~ $treehash{$_} = 1;
+                
+                #~ # Check that all files are under a root which has the same name as the toolbox
+                #~ if(!m#^\Q$TOOLBOXNAME\E/#) {
+                        #~ die "Incorrect archive: \"$_\" is not a child of \"$TOOLBOXNAME\"";
+                #~ }
+        #~ }
+        
+        #~ # Check that basic files are here
+        #~ my @required = qw(DESCRIPTION DESCRIPTION-FUNCTIONS readme.txt license.txt
+                          #~ builder.sce loader.sce);
+        #~ push(@required, "etc/$TOOLBOXNAME.start");
+        #~ push(@required, "etc/$TOOLBOXNAME.end");
+        
+        #~ foreach (@required) {
+                #~ print "$TOOLBOXNAME/$_\n";
+                #~ print %treehash;
+                #~ if(!defined($treehash{"$TOOLBOXNAME/$_"})) {
+                        #~ die "Incorrect archive: required file \"$_\" not present";
+                #~ }
+        #~ }
+}
+
+# Init global vars, check arguments
+$TOOLBOXFILE = shift;
+if(!defined($TOOLBOXFILE)) {
+        die "Toolbox source file required";
+}
+
+if(! -r $TOOLBOXFILE) {
+        die "$TOOLBOXFILE doesn't exists or can't be read";
+}
+
+$TOOLBOXNAME = shift || $1 if ($TOOLBOXFILE =~ /^([^.]+)/);
+
+
+
+
+my @tree = get_tree();
+
+check_tree(@tree, 1);
+