atoms_cc/buildtoolbox.pl: check_tree done
[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         # If it exists and is non-empty, it must contains buildmacros.sce
178         my $macros_empty = 1;
179         my $macros_has_builder = 0;
180         foreach (grep { $_ =~ m#^macros/# } keys %tree) {
181                 if(/\.sc[ie]$/) {
182                         $macros_empty = 0;
183                         $macros_has_builder = 1 if(m#/buildmacros\.sce$#);
184                 }
185                 elsif(!/\/$/) { # Don't be /too/ nazi: allow sub-directories :)
186                         die "Incorrect archive: macros/ must contain only .sci and .sce files".
187                             " (\"$_\" found)";
188                 }
189         }
190         
191         if(!$macros_empty && !$macros_has_builder) {
192                 die "Incorrect archive: macros/ not empty and no buildmacros.sce script found";
193         }
194         
195         # All fortran files must be in src/fortran
196         foreach (grep { $_ =~ /\.f$/} keys %tree) {
197                 if(!m#^src/fortran/#) {
198                         die "Incorrect archive: \"$_\" is a fortran source and hence has to be in ".
199                             "src/fortran";
200                 }
201         }
202
203         # All c files must be in src/c or sci_gateway/{c,fortran}
204         foreach (grep { $_ =~ /\.[ch]$/} keys %tree) {
205                 if(!m#^(src/c|sci_gateway/(c|fortran))/#) {
206                         die "Incorrect archive: \"$_\" is a C source and hence has to be in ".
207                             "src/c, sci_gateway/c or sci_gateway/fortran";
208                 }
209         }
210         
211         # if src/c contains at least a .c file, src/c/buildsrc_c.sce must exists
212         my $has_c_source = grep { $_ =~ m#^src/c/.+\.[ch]$# } keys %tree;
213         my $has_c_src_builder = defined($tree{"src/c/buildsrc_c.sce"});
214         if($has_c_source && !$has_c_src_builder) {
215                 die "Incorrect archives: C source found in src/c/ but no buildsrc_c.sce ".
216                     "script found";
217         }
218         
219         # if src/fortran contains at least a .f file, src/fortran/buildsrc_fortran.sce must exists
220         my $has_f_source = grep { $_ =~ m#^src/fortran/.+\.f$# } keys %tree;
221         my $has_f_src_builder = defined($tree{"src/fortran/buildsrc_fortran.sce"});
222         if($has_f_source && !$has_f_src_builder) {
223                 die "Incorrect archives: Fortran source found in src/fortran/ ".
224                     "but no buildsrc_fortran.sce script found";
225         }
226         
227         # if src/*/buildsrc_*.sce exists, src/buildsrc.sce must exists 
228         my $has_src_builder = defined($tree{"src/buildsrc.sce"});
229         if(($has_f_source || $has_c_source) && !$has_src_builder) {
230                 die "Incorrect archive: sources file found but no buildsrc.sce script found";
231         }
232         
233         # if sci_gateway/fortran contains at least a .c file,
234         # sci_gateway/fortran/buildgateway_fortran.sce must exists.
235         my $has_f_gateway = grep { m#^sci_gateway/fortran/.+\.[ch]$# } keys %tree;
236         my $has_f_gateway_builder = defined($tree{"sci_gateway/fortran/buildgateway_fortran.sce"});
237         if($has_f_gateway && !$has_f_gateway_builder) {
238                 die "Incorrect archive: Fortran gateway found but can't find any builder for it";
239         }
240         
241         # if sci_gateway/c contains at least a .c file, sci_gateway/c/buildgateway_c.sce must exists
242         my $has_c_gateway = grep { m#^sci_gateway/c/.+\.[ch]$# } keys %tree;
243         my $has_c_gateway_builder = defined($tree{"sci_gateway/c/buildgateway_c.sce"});
244         if($has_c_gateway && !$has_c_gateway_builder) {
245                 die "Incorrect archive: C gateway found but can't find any builder for it";
246         }
247         
248         # if sci_gateway/*/buildgateway_*.sce exists, sci_gateway/buildgateway.sce must exists
249         my $has_gateway_builder = defined($tree{"sci_gateway/buildgateway.sce"});
250         if(($has_c_gateway || $has_f_gateway) && !$has_gateway_builder) {
251                 die "Incorrect archive: gateway found no gateway builder (buildgateway.sce) found";
252         }
253         
254         # if help/ contains .xml files, it must contains a buildhelp.sce file
255         my $has_help = grep { m#^help/.+\.xml$# } keys %tree;
256         my $has_help_builder = defined($tree{"help/buildhelp.sce"});
257         if($has_help && !$has_help_builder) {
258                 die "Incorrect archive: help files found but no help builder (buildhelp.sce) found";
259         }
260 }
261
262 # Init global vars, check arguments
263 $TOOLBOXFILE = shift;
264 if(!defined($TOOLBOXFILE)) {
265         die "Toolbox source file required";
266 }
267
268 if(! -r $TOOLBOXFILE) {
269         die "$TOOLBOXFILE doesn't exists or can't be read";
270 }
271
272 $TOOLBOXNAME = $1 if ($TOOLBOXFILE =~ /^([^.]+)/);
273
274
275 check_tree(get_tree());
276