First version: checks DESCRIPTION file.
[scilab.git] / 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