atoms_cc/buildtoolbox.pl

   1 #!/usr/bin/perl -w
   2
   3 # buildtoolbox.pl
   4 # Usage: buildtoolbox.pl toolbox-archive [toolbox-name]
   5
   6 use strict;
   7 use Cwd;
   8
   9 my ($TOOLBOXFILE, # Toolbox archive to compile
  10     $TOOLBOXNAME); # Name of the toolbox
  11
  12 # is_zip:
  13 #    Return true if toolbox file extension is zip
  14 sub is_zip {
  15         return $TOOLBOXFILE =~ /\.zip$/;
  16 }
  17
  18 # get_tree_from_tgz:
  19 #   Get all files (names) of the compressed (in tar.gz) sources
  20 sub get_tree_from_tgz {
  21         my (@files);
  22
  23         open my $fd, "tar -tzf ${TOOLBOXFILE}|";
  24         push(@files, $_) while <$fd>;
  25         chomp(@files);
  26         close $fd;
  27         return @files;
  28 }
  29
  30 # get_tree_from_zip:
  31 #   Get all files (names) of the compressed (in zip) sources
  32 sub get_tree_from_zip {
  33         my (@files, $line);
  34
  35         # tail & head are here to skip header & footer
  36         open my $fd, "unzip -l ${TOOLBOXFILE} | tail -n +4 | head -n -2 |";
  37
  38         while(<$fd>) {
  39                 # output format: size date time filename
  40                 /\s*\d+\s+\d+-\d+-\d+\s+\d+:\d+\s+(.+)/ or die "Bad output of unzip";
  41                 push(@files, $1);
  42         }
  43
  44         chomp(@files);
  45         close $fd;
  46         return @files;
  47 }
  48
  49 # get_tree:
  50 #   Get all files (names) of the compressed sources
  51 sub get_tree {
  52         if(is_zip()) {
  53                 return get_tree_from_zip();
  54         }
  55         else {
  56                 return get_tree_from_tgz();
  57         }
  58 }
  59
  60 # get_description_from_tgz:
  61 #    Extract DESCRIPTION file from the archive (in tar.gz format)
  62 sub get_description_from_tgz {
  63         open my $fd, "tar -xOzf ${TOOLBOXFILE} ${TOOLBOXNAME}/DESCRIPTION |";
  64         return $fd;
  65 }
  66
  67 # get_description_from_tgz:
  68 #    Extract DESCRIPTION file from the archive (in zip format)
  69 sub get_description_from_zip {
  70         open my $fd, "unzip -c ${TOOLBOXFILE} ${TOOLBOXNAME}/DESCRIPTION | tail -n +3 | head -n -1 |";
  71         return $fd;
  72 }
  73
  74 # get_description:
  75 #   Extract DESCRIPTION file from the archive
  76 sub get_description {
  77         if(is_zip) {
  78                 return get_description_from_zip();
  79         }
  80         else {
  81                 return get_description_from_tgz();
  82         }
  83 }
  84
  85 # read_description:
  86 #   Check if DESCRIPTION file is correct, and parse it (return a hash
  87 #   field => value).
  88 #   First argument is a file descriptor for the DESCRIPTION file (see
  89 #   get_description)
  90 sub read_description {
  91         my ($fd) = shift;
  92         my @required = qw(Toolbox Version Title Author Maintainer
  93                           Description License Category);
  94         my @optional = qw(Date Depends URL Entity);
  95         my (%infos, $key, $val);
  96         my (%lines, %correct);
  97
  98         # Populate hash
  99         while(<$fd>) {
 100                 die "\":\" not followed by a space at line $." if(/:(?! )/);
 101                 if(/:/) { # New field
 102                         ($key, $val) = split(/: /, $_, 2);
 103                         $infos{$key} = $val;
 104                         $lines{$key} = $.;
 105                         $correct{$key} = 0;
 106                 }
 107                 else { # Continuation of previous field
 108                         $infos{$key} .= $_;
 109                 }
 110         }
 111
 112         # Check presence of required fields, mark them as correct
 113         foreach (@required) {
 114                 if(!defined($infos{$_})) {
 115                         die "Mandatory field \"$_\" not defined";
 116                 }
 117                 else {
 118                         $correct{$_} = 1;
 119                 }
 120         }
 121
 122         # Mark optional fields as correct
 123         foreach (@optional) {
 124                 if(defined($infos{$_})) {
 125                         $correct{$_} = 1;
 126                 }
 127         }
 128
 129         # Check that there's no incorrect (= unknown) fields
 130         foreach (keys(%infos)) {
 131                 if($correct{$_} == 0) {
 132                         die "Unknown field \"$_\" (defined at line $lines{$_})";
 133                 }
 134         }
 135
 136         chomp %infos;
 137         return %infos;
 138 }
 139
 140
 141
 142 # check_tree:
 143 #   Given a source tree of a toolbox (see get_tree), check if it is correct
 144 #   (required files are present, files are at their right place, and so on...)
 145 sub check_tree {
 146         #~ my @tree = shift;
 147         #~ my %treehash;
 148
 149         #~ print "$#tree\n";
 150         foreach (@_) { print "=> $_ \n"; };
 151
 152         #~ foreach (@tree) {
 153                 #~ # Make a hash from the tree (paths are keys, values are all to 1)
 154                 #~ $treehash{$_} = 1;
 155
 156                 #~ # Check that all files are under a root which has the same name as the toolbox
 157                 #~ if(!m#^\Q$TOOLBOXNAME\E/#) {
 158                         #~ die "Incorrect archive: \"$_\" is not a child of \"$TOOLBOXNAME\"";
 159                 #~ }
 160         #~ }
 161
 162         #~ # Check that basic files are here
 163         #~ my @required = qw(DESCRIPTION DESCRIPTION-FUNCTIONS readme.txt license.txt
 164                           #~ builder.sce loader.sce);
 165         #~ push(@required, "etc/$TOOLBOXNAME.start");
 166         #~ push(@required, "etc/$TOOLBOXNAME.end");
 167
 168         #~ foreach (@required) {
 169                 #~ print "$TOOLBOXNAME/$_\n";
 170                 #~ print %treehash;
 171                 #~ if(!defined($treehash{"$TOOLBOXNAME/$_"})) {
 172                         #~ die "Incorrect archive: required file \"$_\" not present";
 173                 #~ }
 174         #~ }
 175 }
 176
 177 # Init global vars, check arguments
 178 $TOOLBOXFILE = shift;
 179 if(!defined($TOOLBOXFILE)) {
 180         die "Toolbox source file required";
 181 }
 182
 183 if(! -r $TOOLBOXFILE) {
 184         die "$TOOLBOXFILE doesn't exists or can't be read";
 185 }
 186
 187 $TOOLBOXNAME = shift || $1 if ($TOOLBOXFILE =~ /^([^.]+)/);
 188
 189
 190
 191
 192 my @tree = get_tree();
 193
 194 check_tree(@tree, 1);
 195