770636df103f841b4cc388f5553a3b6b5edde204
[scilab.git] / atoms_cc / buildtoolbox.pl
1 #!/usr/bin/perl -w
2
3 # buildtoolbox.pl
4 # Usage: buildtoolbox.pl toolbox-archive [config file [stage]]
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         
25         while(<$fd>) {
26                 chomp;
27                 $files{$_} = 1;
28         }
29         
30         close $fd;
31         return %files;
32 }
33
34 # get_tree_from_zip:
35 #   Get all files (names) of the compressed (in zip) sources
36 sub get_tree_from_zip {
37         my (%files, $line);
38         
39         # tail & head are here to skip header & footer
40         open my $fd, "unzip -l ${TOOLBOXFILE} | tail -n +4 | head -n -2 |";
41         
42         while(<$fd>) {
43                 # zip output format: size date time filename
44                 /\s*\d+\s+\d+-\d+-\d+\s+\d+:\d+\s+(.+)/ or die "Bad output of unzip";
45                 chomp $1;
46                 $files{$1} = 1;
47         }
48         
49         close $fd;
50         return %files;
51 }
52
53 # get_tree:
54 #   Get all files (names) of the compressed sources, in a hash
55 #   (hash values are meaningless, set to 1)
56 sub get_tree {
57         if(is_zip()) {
58                 return get_tree_from_zip();
59         }
60         else {
61                 return get_tree_from_tgz();
62         }
63 }
64
65 # get_description_from_tgz:
66 #    Extract DESCRIPTION file from the archive (in tar.gz format)
67 sub get_description_from_tgz {
68         open my $fd, "tar -xOzf ${TOOLBOXFILE} ${TOOLBOXNAME}/DESCRIPTION |";
69         return $fd;
70 }
71
72 # get_description_from_tgz:
73 #    Extract DESCRIPTION file from the archive (in zip format)
74 sub get_description_from_zip {
75         open my $fd, "unzip -c ${TOOLBOXFILE} ${TOOLBOXNAME}/DESCRIPTION | tail -n +3 | head -n -1 |";
76         return $fd;
77 }
78
79 # get_description:
80 #   Extract DESCRIPTION file from the archive
81 sub get_description {
82         if(is_zip) {
83                 return get_description_from_zip();
84         }
85         else {
86                 return get_description_from_tgz();
87         }
88 }
89
90 # read_description:
91 #   Check if DESCRIPTION file is correct, and parse it (return a hash
92 #   field => value).
93 #   First argument is a file descriptor for the DESCRIPTION file (see
94 #   get_description)
95 sub read_description {
96         my ($fd) = shift;
97         my @required = qw(Toolbox Version Title Author Maintainer
98                           Description License Category);
99         my @optional = qw(Date Depends URL Entity);
100         my (%infos, $key, $val);
101         my (%lines, %correct);
102         
103         # Populate hash
104         while(<$fd>) {
105                 die "\":\" not followed by a space at line $." if(/:(?! )/);
106                 if(/:/) { # New field
107                         ($key, $val) = split(/: /, $_, 2);
108                         $infos{$key} = $val;
109                         $lines{$key} = $.;
110                         $correct{$key} = 0;
111                 }
112                 else { # Continuation of previous field
113                         $infos{$key} .= $_;
114                 }
115         }
116         
117         # Check presence of required fields, mark them as correct
118         foreach (@required) {
119                 if(!defined($infos{$_})) {
120                         die "Mandatory field \"$_\" not defined";
121                 }
122                 else {
123                         $correct{$_} = 1;
124                 }
125         }
126         
127         # Mark optional fields as correct
128         foreach (@optional) {
129                 if(defined($infos{$_})) {
130                         $correct{$_} = 1;
131                 }
132         }
133         
134         # Check that there's no incorrect (= unknown) fields
135         foreach (keys(%infos)) {
136                 if($correct{$_} == 0) {
137                         die "Unknown field \"$_\" (defined at line $lines{$_})";
138                 }
139         }
140         
141         chomp %infos;
142         return %infos;
143 }
144
145 # check_tree:
146 #   Given a source tree of a toolbox (see get_tree), check if it is correct
147 #   (required files are present, files are at their right place, and so on...)
148 sub check_tree {
149         my %tree = @_;
150         my %newtree;
151         
152         # Check that all files are under a root which has the same name as the toolbox
153         # Delete this root to simplify other tests
154         foreach (keys %tree) {
155                 if(s#^\Q$TOOLBOXNAME\E(/|$)##) {
156                         $newtree{$_} = 1 if $_;
157                 }
158                 else {
159                         die "Incorrect archive: \"$_\" is not a child of \"$TOOLBOXNAME\"";
160                 }
161         }
162         %tree = %newtree;
163         
164         # Check that basic files are here
165         my @required = qw(DESCRIPTION DESCRIPTION-FUNCTIONS readme.txt license.txt
166                           builder.sce loader.sce);
167         push(@required, "etc/$TOOLBOXNAME.start");
168         push(@required, "etc/$TOOLBOXNAME.end");
169         
170         foreach (@required) {
171                 if(!defined($tree{$_})) {
172                         die "Incorrect archive: required file \"$_\" not present";
173                 }
174         }
175         
176         # macros/ must contain only .sci and .sce files
177         foreach (grep { $_ =~ m#^macros/# } keys %tree) {
178                 if(!/(\.sc[ie]|\/)$/) {
179                         die "Incorrect archive: macros/ must contain only .sci and .sce files".
180                             " (\"$_\" found)";
181                 }
182         }
183         
184         # All fortran files must be in src/fortran
185         foreach (grep { $_ =~ /\.f$/} keys %tree) {
186                 if(!m#^src/fortran/#) {
187                         die "Incorrect archive: \"$_\" is a fortran source and hence has to be in ".
188                             "src/fortran";
189                 }
190         }
191
192         # All c files must be in src/c or sci_gateway/{c,fortran}
193         foreach (grep { $_ =~ /\.[ch]$/} keys %tree) {
194                 if(!m#^(src/c|sci_gateway/(c|fortran))/#) {
195                         die "Incorrect archive: \"$_\" is a C source and hence has to be in ".
196                             "src/c, sci_gateway/c or sci_gateway/fortran";
197                 }
198         }
199         
200         # Constraints: if $key exists, $constraints{$key} must exist
201         my %constraints = (
202                 qr#help/.+\.xml$# => "help/buildhelp.sce",
203                 qr#macros/.+\.sc[ie]$# => "macros/buildmacros.sce");
204         
205         # Build constraints for allowed languages
206         my %languages = (
207                 "c" => qr/[ch]/,
208                 "fortran" => qr/f/);
209         
210         foreach (keys %languages) {
211                 # if src/(lang) has source files, src/(lang)/buildsrc_(lang).sce must exist
212                 $constraints{qr#^src/$_/.+\.$languages{$_}$#} = "src/$_/buildsrc_$_.sce";
213                 
214                 # if sci_gateway/(lang) has C sources, sci_gateway/(lang)/buildgateway_(lang).sce
215                 # must exist
216                 $constraints{qr#^sci_gateway/$_/.+[ch]$#} = "sci_gateway/$_/buildgateway_$_.sce";
217                 
218                 # if src/(lang)/buildsrc_(lang).sce exist, src/buildsrc.sce must exist
219                 $constraints{qr#^src/$_/buildsrc_$_.sce$#} = "src/buildsrc.sce";
220                 
221                 # if sci_gateway/(lang)/buildgateway_(lang).sce exist, sci_gateway/buildgateway.sce must exist
222                 $constraints{qr#^sci_gateway/$_/buildgateway_$_.sce$#} = "sci_gateway/buildgateway.sce";
223         }
224         
225         # Check constraints
226         foreach my $constraint (keys %constraints) {
227                 my $required = $constraints{$constraint};
228                 my @found = grep { $_ =~ $constraint } keys %tree;
229                 if(@found && !defined($tree{$required})) {
230                         die "Invalid archive: \"$found[0]\" needs \"$required\", which isn't in the archive";
231                 }
232         }
233 }
234
235 # Init global vars, check arguments
236 $TOOLBOXFILE = shift;
237 if(!defined($TOOLBOXFILE)) {
238         die "Toolbox source file required";
239 }
240
241 if(! -r $TOOLBOXFILE) {
242         die "$TOOLBOXFILE doesn't exists or can't be read";
243 }
244
245 $TOOLBOXNAME = $1 if ($TOOLBOXFILE =~ /^([^.]+)/);
246
247
248 check_tree(get_tree());
249