827e726eab2a1ef1ba09dbce57a40bdafa1e32ed
[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         
151         # Check that all files are under a root which has the same name as the toolbox
152         foreach (keys %tree) {
153                 if(!m#^\Q$TOOLBOXNAME\E/#) {
154                         die "Incorrect archive: \"$_\" is not a child of \"$TOOLBOXNAME\"";
155                 }
156         }
157         
158         # Check that basic files are here
159         my @required = qw(DESCRIPTION DESCRIPTION-FUNCTIONS readme.txt license.txt
160                           builder.sce loader.sce);
161         push(@required, "etc/$TOOLBOXNAME.start");
162         push(@required, "etc/$TOOLBOXNAME.end");
163         
164         foreach (@required) {
165                 if(!defined($tree{"$TOOLBOXNAME/$_"})) {
166                         die "Incorrect archive: required file \"$_\" not present";
167                 }
168         }
169         
170         # 
171 }
172
173 # Init global vars, check arguments
174 $TOOLBOXFILE = shift;
175 if(!defined($TOOLBOXFILE)) {
176         die "Toolbox source file required";
177 }
178
179 if(! -r $TOOLBOXFILE) {
180         die "$TOOLBOXFILE doesn't exists or can't be read";
181 }
182
183 $TOOLBOXNAME = $1 if ($TOOLBOXFILE =~ /^([^.]+)/);
184
185
186 check_tree(get_tree());
187