summaryrefslogtreecommitdiffstats
path: root/atoms_cc
diff options
context:
space:
mode:
authorSimon Lipp <simon.lipp@scilab.org>2008-06-26 13:40:48 +0000
committerSimon Lipp <simon.lipp@scilab.org>2008-06-26 13:40:48 +0000
commit0e8680d3ad8b36fcf124b83bcbd457c312f013b6 (patch)
tree32f17350141d21cbbe89de9915c8662dc47fb80a /atoms_cc
parentdc691cc7609524c63322bb6ea561a770fc59b4ab (diff)
downloadscilab-0e8680d3ad8b36fcf124b83bcbd457c312f013b6.zip
scilab-0e8680d3ad8b36fcf124b83bcbd457c312f013b6.tar.gz
atoms_cc/buildtoolbox:
* add logging functions (common_log, common_enter_stage, common_leave_stage, common_die, common_exec) * check DESCRIPTION-FUNCTIONS file * 'check' stage (hopefully) done... have to check on windows, though :(
Diffstat (limited to 'atoms_cc')
-rwxr-xr-xatoms_cc/buildtoolbox.pl234
1 files changed, 201 insertions, 33 deletions
diff --git a/atoms_cc/buildtoolbox.pl b/atoms_cc/buildtoolbox.pl
index 770636d..fa5d36d 100755
--- a/atoms_cc/buildtoolbox.pl
+++ b/atoms_cc/buildtoolbox.pl
@@ -7,7 +7,91 @@ use strict;
7use Cwd; 7use Cwd;
8 8
9my ($TOOLBOXFILE, # Toolbox archive to compile 9my ($TOOLBOXFILE, # Toolbox archive to compile
10 $TOOLBOXNAME); # Name of the toolbox 10 $TOOLBOXNAME, # Name of the toolbox
11 $STAGE); # Current stage
12
13# common_log:
14# Print a log message. Seconf argument is the type of the
15# message:
16# " " for a normal message
17# "!" for an error
18# ">" when starting a stage
19# "<" when terminating a stage
20# "$" when running a command
21# "?" for the return code of previous command
22sub common_log {
23 my $message = shift;
24 my $type = shift || " ";
25
26 # Check message format: any newline must start by a space,
27 # no new line at end of message
28 $message =~ s/(?<=\n)(?!\s|$)/ /g;
29 chomp $message;
30
31 print LOGFILE "[".time()."]${type}${message}\n";
32}
33
34# common_enter_stage:
35# Common stuff while starting a new stage
36sub common_enter_stage {
37 $STAGE = shift;
38 common_log($STAGE, ">");
39}
40
41# common_leave_stage:
42# Common stuff while ending new stage
43sub common_leave_stage {
44 common_log($STAGE, "<");
45}
46
47# common_die:
48# Called when a problem happens
49sub common_die {
50 my $message = shift;
51 common_log($message, "!");
52 common_leave_stage();
53
54 while(wait() > 0) { };
55 close LOGFILE;
56 exit(1);
57}
58
59# common_exec:
60# Execute given command, places its outputs to log files.
61# Returns a file handle on STDOUT
62# Die if return code is non-zero
63sub common_exec {
64 my $cmd = shift;
65 my $commandnum = 1;
66
67 # Find commandnum: log files are (stage)-1.out for first
68 # command of (stage), (stage)-2.out for second command of stage,
69 # and so on
70 $commandnum++ while(-e "$STAGE-$commandnum.out");
71
72 my $stdout = "$STAGE-$commandnum.out";
73 my $stderr = "$STAGE-$commandnum.err";
74
75 common_log("$cmd\nstdout=$stdout\nstderr=$stderr", "\$");
76
77 my $pid = fork();
78 if($pid == 0) {
79 open STDOUT, ">$stdout";
80 open STDERR, ">$stderr";
81 exec $cmd;
82 }
83 else {
84 waitpid($pid, 0);
85 common_log("$?", "?");
86 if($? != 0) {
87 common_die("\"$cmd\" failed");
88 }
89 }
90
91 open my ($fd), $stdout;
92
93 return $fd;
94}
11 95
12# is_zip: 96# is_zip:
13# Return true if toolbox file extension is zip 97# Return true if toolbox file extension is zip
@@ -20,7 +104,7 @@ sub is_zip {
20sub get_tree_from_tgz { 104sub get_tree_from_tgz {
21 my %files; 105 my %files;
22 106
23 open my $fd, "tar -tzf ${TOOLBOXFILE}|"; 107 my $fd = common_exec("tar -tzf ${TOOLBOXFILE}");
24 108
25 while(<$fd>) { 109 while(<$fd>) {
26 chomp; 110 chomp;
@@ -37,11 +121,11 @@ sub get_tree_from_zip {
37 my (%files, $line); 121 my (%files, $line);
38 122
39 # tail & head are here to skip header & footer 123 # tail & head are here to skip header & footer
40 open my $fd, "unzip -l ${TOOLBOXFILE} | tail -n +4 | head -n -2 |"; 124 my $fd = common_exec("unzip -l ${TOOLBOXFILE} | tail -n +4 | head -n -2");
41 125
42 while(<$fd>) { 126 while(<$fd>) {
43 # zip output format: size date time filename 127 # zip output format: size date time filename
44 /\s*\d+\s+\d+-\d+-\d+\s+\d+:\d+\s+(.+)/ or die "Bad output of unzip"; 128 /\s*\d+\s+\d+-\d+-\d+\s+\d+:\d+\s+(.+)/ or common_die "Bad output of unzip";
45 chomp $1; 129 chomp $1;
46 $files{$1} = 1; 130 $files{$1} = 1;
47 } 131 }
@@ -62,28 +146,28 @@ sub get_tree {
62 } 146 }
63} 147}
64 148
65# get_description_from_tgz: 149# read_file_from_tgz:
66# Extract DESCRIPTION file from the archive (in tar.gz format) 150# Extract given file from the .zip archive
67sub get_description_from_tgz { 151sub read_file_from_tgz {
68 open my $fd, "tar -xOzf ${TOOLBOXFILE} ${TOOLBOXNAME}/DESCRIPTION |"; 152 my $filename = shift;
69 return $fd; 153 return common_exec("tar -xOzf ${TOOLBOXFILE} ${TOOLBOXNAME}/$filename");
70} 154}
71 155
72# get_description_from_tgz: 156# read_file_from_tgz:
73# Extract DESCRIPTION file from the archive (in zip format) 157# Extract given file from the .tar.gz archive
74sub get_description_from_zip { 158sub read_file_from_zip {
75 open my $fd, "unzip -c ${TOOLBOXFILE} ${TOOLBOXNAME}/DESCRIPTION | tail -n +3 | head -n -1 |"; 159 my $filename = shift;
76 return $fd; 160 return common_exec("unzip -c ${TOOLBOXFILE} ${TOOLBOXNAME}/$filename | tail -n +3 | head -n -1");
77} 161}
78 162
79# get_description: 163# read_file_from_archive:
80# Extract DESCRIPTION file from the archive 164# Extract given file from the archive
81sub get_description { 165sub read_file_from_archive {
82 if(is_zip) { 166 if(is_zip()) {
83 return get_description_from_zip(); 167 return read_file_from_zip(@_);
84 } 168 }
85 else { 169 else {
86 return get_description_from_tgz(); 170 return read_file_from_tgz(@_);
87 } 171 }
88} 172}
89 173
@@ -93,7 +177,7 @@ sub get_description {
93# First argument is a file descriptor for the DESCRIPTION file (see 177# First argument is a file descriptor for the DESCRIPTION file (see
94# get_description) 178# get_description)
95sub read_description { 179sub read_description {
96 my ($fd) = shift; 180 my $fd = shift;
97 my @required = qw(Toolbox Version Title Author Maintainer 181 my @required = qw(Toolbox Version Title Author Maintainer
98 Description License Category); 182 Description License Category);
99 my @optional = qw(Date Depends URL Entity); 183 my @optional = qw(Date Depends URL Entity);
@@ -102,7 +186,7 @@ sub read_description {
102 186
103 # Populate hash 187 # Populate hash
104 while(<$fd>) { 188 while(<$fd>) {
105 die "\":\" not followed by a space at line $." if(/:(?! )/); 189 common_die "\":\" not followed by a space at line $." if(/:(?! )/);
106 if(/:/) { # New field 190 if(/:/) { # New field
107 ($key, $val) = split(/: /, $_, 2); 191 ($key, $val) = split(/: /, $_, 2);
108 $infos{$key} = $val; 192 $infos{$key} = $val;
@@ -117,7 +201,7 @@ sub read_description {
117 # Check presence of required fields, mark them as correct 201 # Check presence of required fields, mark them as correct
118 foreach (@required) { 202 foreach (@required) {
119 if(!defined($infos{$_})) { 203 if(!defined($infos{$_})) {
120 die "Mandatory field \"$_\" not defined"; 204 common_die "Mandatory field \"$_\" not defined";
121 } 205 }
122 else { 206 else {
123 $correct{$_} = 1; 207 $correct{$_} = 1;
@@ -134,7 +218,7 @@ sub read_description {
134 # Check that there's no incorrect (= unknown) fields 218 # Check that there's no incorrect (= unknown) fields
135 foreach (keys(%infos)) { 219 foreach (keys(%infos)) {
136 if($correct{$_} == 0) { 220 if($correct{$_} == 0) {
137 die "Unknown field \"$_\" (defined at line $lines{$_})"; 221 common_die "Unknown field \"$_\" (defined at line $lines{$_})";
138 } 222 }
139 } 223 }
140 224
@@ -142,6 +226,33 @@ sub read_description {
142 return %infos; 226 return %infos;
143} 227}
144 228
229# read_description_functions:
230# Parse DESCRIPTION-FUNCTIONS file (and check it, too). Like DESCRIPTION,
231# first argument is a file descriptor. Returns a hash function name =>
232# function description
233sub read_description_functions {
234 my $fd = shift;
235 my (%funcs, $func, $desc);
236
237 while(<$fd>) {
238 if(/-/ && !/ - /) {
239 common_die "\"-\" not surrounded by spaces at line $.";
240 }
241
242 if(/-/) { # New field
243 ($func, $desc) = split(/ - /, $_, 2);
244 $funcs{$func} = $desc;
245 }
246 else { # Previous function description continuation
247 $funcs{$func} .= $_;
248 }
249 }
250
251 chomp %funcs;
252
253 return %funcs;
254}
255
145# check_tree: 256# check_tree:
146# Given a source tree of a toolbox (see get_tree), check if it is correct 257# 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...) 258# (required files are present, files are at their right place, and so on...)
@@ -156,7 +267,7 @@ sub check_tree {
156 $newtree{$_} = 1 if $_; 267 $newtree{$_} = 1 if $_;
157 } 268 }
158 else { 269 else {
159 die "Incorrect archive: \"$_\" is not a child of \"$TOOLBOXNAME\""; 270 common_die "Incorrect archive: \"$_\" is not a child of \"$TOOLBOXNAME\"";
160 } 271 }
161 } 272 }
162 %tree = %newtree; 273 %tree = %newtree;
@@ -169,14 +280,14 @@ sub check_tree {
169 280
170 foreach (@required) { 281 foreach (@required) {
171 if(!defined($tree{$_})) { 282 if(!defined($tree{$_})) {
172 die "Incorrect archive: required file \"$_\" not present"; 283 common_die "Incorrect archive: required file \"$_\" not present";
173 } 284 }
174 } 285 }
175 286
176 # macros/ must contain only .sci and .sce files 287 # macros/ must contain only .sci and .sce files
177 foreach (grep { $_ =~ m#^macros/# } keys %tree) { 288 foreach (grep { $_ =~ m#^macros/# } keys %tree) {
178 if(!/(\.sc[ie]|\/)$/) { 289 if(!/(\.sc[ie]|\/)$/) {
179 die "Incorrect archive: macros/ must contain only .sci and .sce files". 290 common_die "Incorrect archive: macros/ must contain only .sci and .sce files".
180 " (\"$_\" found)"; 291 " (\"$_\" found)";
181 } 292 }
182 } 293 }
@@ -184,7 +295,7 @@ sub check_tree {
184 # All fortran files must be in src/fortran 295 # All fortran files must be in src/fortran
185 foreach (grep { $_ =~ /\.f$/} keys %tree) { 296 foreach (grep { $_ =~ /\.f$/} keys %tree) {
186 if(!m#^src/fortran/#) { 297 if(!m#^src/fortran/#) {
187 die "Incorrect archive: \"$_\" is a fortran source and hence has to be in ". 298 common_die "Incorrect archive: \"$_\" is a fortran source and hence has to be in ".
188 "src/fortran"; 299 "src/fortran";
189 } 300 }
190 } 301 }
@@ -192,7 +303,7 @@ sub check_tree {
192 # All c files must be in src/c or sci_gateway/{c,fortran} 303 # All c files must be in src/c or sci_gateway/{c,fortran}
193 foreach (grep { $_ =~ /\.[ch]$/} keys %tree) { 304 foreach (grep { $_ =~ /\.[ch]$/} keys %tree) {
194 if(!m#^(src/c|sci_gateway/(c|fortran))/#) { 305 if(!m#^(src/c|sci_gateway/(c|fortran))/#) {
195 die "Incorrect archive: \"$_\" is a C source and hence has to be in ". 306 common_die "Incorrect archive: \"$_\" is a C source and hence has to be in ".
196 "src/c, sci_gateway/c or sci_gateway/fortran"; 307 "src/c, sci_gateway/c or sci_gateway/fortran";
197 } 308 }
198 } 309 }
@@ -227,23 +338,80 @@ sub check_tree {
227 my $required = $constraints{$constraint}; 338 my $required = $constraints{$constraint};
228 my @found = grep { $_ =~ $constraint } keys %tree; 339 my @found = grep { $_ =~ $constraint } keys %tree;
229 if(@found && !defined($tree{$required})) { 340 if(@found && !defined($tree{$required})) {
230 die "Invalid archive: \"$found[0]\" needs \"$required\", which isn't in the archive"; 341 common_die "Invalid archive: \"$found[0]\" needs \"$required\", which isn't in the archive";
231 } 342 }
232 } 343 }
233} 344}
234 345
346# stage_check:
347# Perform basic checks
348sub stage_check {
349 common_enter_stage("check");
350
351 if(is_zip()) {
352 common_log("Detected ZIP format");
353 }
354 else {
355 common_log("Detected TAR+GZIP format");
356 }
357
358 # Check tree
359 common_log("Checking archive structure");
360 my %tree = get_tree();
361 common_log("Archive files:\n" . join("\n", sort keys %tree));
362 check_tree(%tree);
363
364 # Check DESCRIPTION
365 common_log("Checking DESCRIPTION");
366 my $fd = read_file_from_archive("DESCRIPTION");
367 my %desc = read_description($fd);
368 common_log("Computed DESCRIPTION:\n" .
369 join("\n", map { "$_: $desc{$_}" } sort keys %desc));
370
371 # Check toolbox name
372 if($TOOLBOXNAME ne $desc{"Toolbox"}) {
373 common_die "Detected toolbox name ($TOOLBOXNAME) different from ".
374 "DESCRIPTION version ($desc{Toolbox})";
375 }
376
377 # Check version
378 my $version = $1 if ($TOOLBOXFILE =~ /[^.]+\.([^-]+)/);
379 if(!defined($version)) {
380 common_die "Can't detect version from archive name ($TOOLBOXFILE)";
381 }
382
383 if($version ne $desc{"Version"}) {
384 common_die "Detected version ($version) different from DESCRIPTION ".
385 "version ($desc{Version})";
386 }
387
388 # Check DESCRIPTION-FUNCTIONS
389 common_log("Checking DESCRIPTION-FUNCTIONS");
390 $fd = read_file_from_archive("DESCRIPTION-FUNCTIONS");
391 my %funcs = read_description_functions($fd);
392 common_log("Computed DESCRIPTION-FUNCTIONS:\n" .
393 join("\n", map { "$_: $funcs{$_}" } sort keys %funcs));
394
395 common_leave_stage("check");
396}
397
235# Init global vars, check arguments 398# Init global vars, check arguments
236$TOOLBOXFILE = shift; 399$TOOLBOXFILE = shift;
237if(!defined($TOOLBOXFILE)) { 400if(!defined($TOOLBOXFILE)) {
238 die "Toolbox source file required"; 401 common_die "Toolbox source file required";
239} 402}
240 403
241if(! -r $TOOLBOXFILE) { 404if(! -r $TOOLBOXFILE) {
242 die "$TOOLBOXFILE doesn't exists or can't be read"; 405 common_die "$TOOLBOXFILE doesn't exists or can't be read";
243} 406}
244 407
245$TOOLBOXNAME = $1 if ($TOOLBOXFILE =~ /^([^.]+)/); 408$TOOLBOXNAME = $1 if ($TOOLBOXFILE =~ /^([^.]+)/);
246 409
410open LOGFILE, ">build.log";
411
412common_log "Toolbox: $TOOLBOXNAME";
413common_log "Source file: $TOOLBOXFILE";
247 414
248check_tree(get_tree()); 415stage_check;
249 416
417close LOGFILE;