/[jscoverage]/trunk/js/config/preprocessor.pl
ViewVC logotype

Contents of /trunk/js/config/preprocessor.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 399 - (show annotations)
Tue Dec 9 03:37:47 2008 UTC (10 years, 8 months ago) by siliconforks
File MIME type: text/plain
File size: 18397 byte(s)
Use SpiderMonkey from Firefox 3.1b2.

1 #!/usr/bin/perl -w
2 # -*- Mode: perl; tab-width: 4; indent-tabs-mode: nil; -*-
3 #
4 # Preprocessor
5 # Version 1.1
6 #
7 # Copyright (c) 2002, 2003, 2004 by Ian Hickson
8 #
9 # This program is free software; you can redistribute it and/or modify
10 # it under the terms of the GNU General Public License as published by
11 # the Free Software Foundation; either version 2 of the License, or
12 # (at your option) any later version.
13 #
14 # This program is distributed in the hope that it will be useful, but
15 # WITHOUT ANY WARRANTY; without even the implied warranty of
16 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
17 # General Public License for more details.
18 #
19 # You should have received a copy of the GNU General Public License
20 # along with this program; if not, write to the Free Software
21 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
22
23 # Thanks to bryner and bsmedberg for suggestions.
24 # Thanks to jon rekai for a patch to not require File::Spec 0.8.
25
26 use strict;
27
28 # takes as arguments the files to process
29 # defaults to stdin
30 # output to stdout
31
32 my $stack = new stack;
33 my $marker = '#';
34
35 # command line arguments
36 my @includes;
37 while ($_ = $ARGV[0], defined($_) && /^-./) {
38 shift;
39 last if /^--$/os;
40 if (/^-D(.*)$/os) {
41 for ($1) {
42 if (/^([\w\.]+)=(.*)$/os) {
43 $stack->define($1, $2);
44 } elsif (/^([\w\.]+)$/os) {
45 $stack->define($1, 1);
46 } else {
47 die "$0: invalid argument to -D: $_\n";
48 }
49 }
50 } elsif (/^-F(.*)$/os) {
51 for ($1) {
52 if (/^(\w+)$/os) {
53 $stack->filter($1, 1);
54 } else {
55 die "$0: invalid argument to -F: $_\n";
56 }
57 }
58 } elsif (/^-I(.*)$/os) {
59 push(@includes, $1);
60 } elsif (/^-E$/os) {
61 foreach (keys %ENV) {
62 # define all variables that have valid names
63 $stack->define($_, $ENV{$_}) unless m/\W/;
64 }
65 } elsif (/^-d$/os) {
66 $stack->{'dependencies'} = 1;
67 } elsif (/^--line-endings=crlf$/os) {
68 $stack->{'lineEndings'} = "\x0D\x0A";
69 } elsif (/^--line-endings=cr$/os) {
70 $stack->{'lineEndings'} = "\x0D";
71 } elsif (/^--line-endings=lf$/os) {
72 $stack->{'lineEndings'} = "\x0A";
73 } elsif (/^--line-endings=(.+)$/os) {
74 die "$0: unrecognised line ending: $1\n";
75 } elsif (/^--marker=(.)$/os) {
76 $marker = $1;
77 } else {
78 die "$0: invalid argument: $_\n";
79 }
80 }
81 unshift(@ARGV, '-') unless @ARGV;
82 unshift(@ARGV, @includes);
83
84 # do the work
85 foreach (@ARGV) { include($stack, $_); }
86 exit(0);
87
88 ########################################################################
89
90 package main;
91 use File::Spec;
92 use File::Spec::Unix; # on all platforms, because the #include syntax is unix-based
93
94 # Note: Ideally we would use File::Spec 0.8. When this becomes
95 # possible, add "0.8" to the first "use" line above, then replace
96 # occurrences of "::_0_8::" with "->" below. And remove the code for
97 # File::Spec 0.8 much lower down the file.
98
99 sub include {
100 my($stack, $filename) = @_;
101 my $directory = $stack->{'variables'}->{'DIRECTORY'};
102 if ($filename ne '-') {
103 $filename = File::Spec::_0_8::rel2abs($filename, $directory);
104 # splitpath expects forward-slash paths on windows, so we have to
105 # change the slashes if using Activestate Perl.
106 $filename =~ s?\\?/?g if "$^O" eq "MSWin32";
107 my($volume, $path) = File::Spec::_0_8::splitpath($filename);
108 $directory = File::Spec::_0_8::catpath($volume, $path, '');
109 }
110 local $stack->{'variables'}->{'DIRECTORY'} = $directory;
111 local $stack->{'variables'}->{'FILE'} = $filename;
112 local $stack->{'variables'}->{'LINE'} = 0;
113 local *FILE;
114 open(FILE, $filename) or die "Couldn't open $filename: $!\n";
115 my $lineout = 0;
116 while (<FILE>) {
117 # on cygwin, line endings are screwed up, so normalise them.
118 s/[\x0D\x0A]+$/\n/os if ($^O eq 'msys' || $^O eq 'cygwin' || "$^O" eq "MSWin32");
119 $stack->newline;
120 if (/^\Q$marker\E([a-z]+)\n?$/os) { # argumentless processing instruction
121 process($stack, $1);
122 } elsif (/^\Q$marker\E([a-z]+)\s(.*?)\n?$/os) { # processing instruction with arguments
123 process($stack, $1, $2);
124 } elsif (/^\Q$marker\E/os) { # comment
125 # ignore it
126 } elsif ($stack->enabled) {
127 next if $stack->{'dependencies'};
128
129 # set the current line number in JavaScript if necessary
130 my $linein = $stack->{'variables'}->{'LINE'};
131 if (++$lineout != $linein) {
132 if ($filename =~ /\.js(|\.in)$/o) {
133 $stack->print("//\@line $linein \"$filename\"\n")
134 }
135 $lineout = $linein;
136 }
137
138 # print it, including any newlines
139 $stack->print(filtered($stack, $_));
140 }
141 }
142 close(FILE);
143 }
144
145 sub process {
146 my($stack, $instruction, @arguments) = @_;
147 my $method = 'preprocessor'->can($instruction);
148 if (not defined($method)) {
149 fatal($stack, 'unknown instruction', $instruction);
150 }
151 eval { &$method($stack, @arguments) };
152 if ($@) {
153 fatal($stack, "error evaluating $instruction:", $@);
154 }
155 }
156
157 sub filtered {
158 my($stack, $text) = @_;
159 foreach my $filter (sort keys %{$stack->{'filters'}}) {
160 next unless $stack->{'filters'}->{$filter};
161 my $method = 'filter'->can($filter);
162 if (not defined($method)) {
163 fatal($stack, 'unknown filter', $filter);
164 }
165 $text = eval { &$method($stack, $text) };
166 if ($@) {
167 fatal($stack, "error using $filter:", $@);
168 }
169 }
170 return $text;
171 }
172
173 sub fatal {
174 my $stack = shift;
175 my $filename = $stack->{'variables'}->{'FILE'};
176 local $" = ' ';
177 print STDERR "$0:$filename:$.: @_\n";
178 exit(1);
179 }
180
181
182 ########################################################################
183
184 package stack;
185
186 # condition evaluated just prior to this context was false
187 use constant COND_FALSE => 0;
188
189 # condition evaluated just prior to this context was true
190 use constant COND_TRUE => 1;
191
192 # some prior condition at this level already evaluated to true (or a
193 # parent condition evaluated to false or must be ignored), so we're
194 # ignoring all remaining conditions at current level (and nested
195 # conditions, too)
196 use constant COND_COMPLETED => 2;
197
198 sub new {
199 return bless {
200 'variables' => {
201 # %ENV,
202 'LINE' => 0, # the line number in the source file
203 'DIRECTORY' => '', # current directory
204 'FILE' => '', # source filename
205 '1' => 1, # for convenience (the constant '1' is thus true)
206 },
207 'filters' => {
208 # filters
209 },
210 'values' => [], # the value of the last condition evaluated at the nth level
211 'lastConditionState' => [], # whether the condition in the nth-level context was true, false, or not applicable
212 'conditionState' => COND_TRUE,
213 'dependencies' => 0, # whether we are showing dependencies
214 'lineEndings' => "\n", # default to platform conventions
215 };
216 }
217
218 sub newline {
219 my $self = shift;
220 $self->{'variables'}->{'LINE'}++;
221 }
222
223 sub define {
224 my $self = shift;
225 my($variable, $value) = @_;
226 die "not a valid variable name: '$variable'\n" if $variable =~ m/[^\w\.]/;
227 $self->{'variables'}->{$variable} = $value;
228 }
229
230 sub defined {
231 my $self = shift;
232 my($variable) = @_;
233 die "not a valid variable name: '$variable'\n" if $variable =~ m/[^\w\.]/;
234 return defined($self->{'variables'}->{$variable});
235 }
236
237 sub undefine {
238 my $self = shift;
239 my($variable) = @_;
240 die "not a valid variable name: '$variable'\n" if $variable =~ m/[^\w\.]/;
241 delete($self->{'variables'}->{$variable});
242 }
243
244 sub get {
245 my $self = shift;
246 my($variable, $required) = @_;
247 die "not a valid variable name: '$variable'\n" if $variable =~ m/[^\w\.]/;
248 my $value = $self->{'variables'}->{$variable};
249 if (defined($value)) {
250 return $value;
251 } else {
252 die "variable '$variable' is not defined\n" if $required;
253 return '';
254 }
255 }
256
257 sub replace {
258 my $self = shift;
259 my ($value) = @_;
260
261 ${$self->{'values'}}[-1] = $value;
262 $self->{'conditionState'} = $self->{'conditionState'} != COND_FALSE
263 ? COND_COMPLETED
264 : $value ? COND_TRUE : COND_FALSE;
265 }
266
267 sub push {
268 my $self = shift;
269 my($value) = @_;
270
271 push(@{$self->{'values'}}, $value);
272 my $lastCondition = $self->{'conditionState'};
273 push(@{$self->{'lastConditionState'}}, $lastCondition);
274 $self->{'conditionState'} = $lastCondition != COND_TRUE
275 ? COND_COMPLETED
276 : $value ? COND_TRUE : COND_FALSE;
277 }
278
279 sub pop {
280 my $self = shift;
281 $self->{'conditionState'} = pop(@{$self->{'lastConditionState'}});
282 return pop(@{$self->{'values'}});
283 }
284
285 sub enabled {
286 my $self = shift;
287 return $self->{'conditionState'} == COND_TRUE;
288 }
289
290 sub disabled {
291 my $self = shift;
292 return $self->{'conditionState'} != COND_TRUE;
293 }
294
295 sub filter {
296 my $self = shift;
297 my($filter, $value) = @_;
298 die "not a valid filter name: '$filter'\n" if $filter =~ m/\W/;
299 $self->{'filters'}->{$filter} = $value;
300 }
301
302 sub expand {
303 my $self = shift;
304 my($line) = @_;
305 $line =~ s/__(\w+)__/$self->get($1)/gose;
306 return $line;
307 }
308
309 sub print {
310 my $self = shift;
311 return if $self->{'dependencies'};
312 foreach my $line (@_) {
313 if (chomp $line) {
314 CORE::print("$line$self->{'lineEndings'}");
315 } else {
316 CORE::print($line);
317 }
318 }
319 }
320
321 sub visit {
322 my $self = shift;
323 my($filename) = @_;
324 my $directory = $stack->{'variables'}->{'DIRECTORY'};
325 $filename = File::Spec::_0_8::abs2rel(File::Spec::_0_8::rel2abs($filename, $directory));
326 CORE::print("$filename\n");
327 }
328
329 ########################################################################
330
331 package preprocessor;
332
333 sub define {
334 my $stack = shift;
335 return if $stack->disabled;
336 die "argument expected\n" unless @_;
337 my $argument = shift;
338 for ($argument) {
339 /^(\w+)\s(.*)$/os && do {
340 return $stack->define($1, $2);
341 };
342 /^(\w+)$/os && do {
343 return $stack->define($1, 1);
344 };
345 die "invalid argument: '$_'\n";
346 }
347 }
348
349 sub undef {
350 my $stack = shift;
351 return if $stack->disabled;
352 die "argument expected\n" unless @_;
353 $stack->undefine(@_);
354 }
355
356 sub ifdef {
357 my $stack = shift;
358 my $variable = shift;
359 my $replace = defined(shift);
360 die "argument expected\n" unless defined($variable);
361 if ($replace) {
362 $stack->replace($stack->defined($variable));
363 } else {
364 $stack->push($stack->defined($variable));
365 }
366 }
367
368 sub ifndef {
369 my $stack = shift;
370 my $variable = shift;
371 my $replace = defined(shift);
372 die "argument expected\n" unless defined($variable);
373 if ($replace) {
374 $stack->replace(not $stack->defined($variable));
375 } else {
376 $stack->push(not $stack->defined($variable));
377 }
378 }
379
380 sub if {
381 my $stack = shift;
382 die "argument expected\n" unless @_;
383 my $argument = shift;
384 my $replace = defined(shift);
385 for ($argument) {
386 /^(\w+)==(.*)$/os && do {
387 # equality
388 if ($replace) {
389 return $stack->replace($stack->get($1) eq $2);
390 } else {
391 return $stack->push($stack->get($1) eq $2);
392 }
393 };
394 /^(\w+)!=(.*)$/os && do {
395 # inequality
396 if ($replace) {
397 return $stack->replace($stack->get($1) ne $2);
398 } else {
399 return $stack->push($stack->get($1) ne $2);
400 }
401 };
402 /^(\w+)$/os && do {
403 # true value
404 if ($replace) {
405 return $stack->replace($stack->get($1));
406 } else {
407 return $stack->push($stack->get($1));
408 }
409 };
410 /^!(\w+)$/os && do {
411 # false value
412 if ($replace) {
413 return $stack->replace(not $stack->get($1));
414 } else {
415 return $stack->push(not $stack->get($1));
416 }
417 };
418 die "invalid argument: '$_'\n";
419 }
420 }
421
422 sub else {
423 my $stack = shift;
424 die "argument unexpected\n" if @_;
425 $stack->replace(1);
426 }
427
428 sub elif {
429 my $stack = shift;
430 die "argument expected\n" unless @_;
431 &if($stack, @_, 1);
432 }
433
434 sub elifdef {
435 my $stack = shift;
436 die "argument expected\n" unless @_;
437 &ifdef($stack, @_, 1);
438 }
439
440 sub elifndef {
441 my $stack = shift;
442 die "argument expected\n" unless @_;
443 &ifndef($stack, @_, 1);
444 }
445
446 sub endif {
447 my $stack = shift;
448 die "argument unexpected\n" if @_;
449 $stack->pop;
450 }
451
452 sub error {
453 my $stack = shift;
454 return if $stack->disabled;
455 die "argument expected\n" unless @_;
456 my $line = $stack->expand(@_);
457 die "$line\n";
458 }
459
460 sub expand {
461 my $stack = shift;
462 return if $stack->disabled;
463 die "argument expected\n" unless @_;
464 my $line = $stack->expand(@_);
465 $stack->print("$line\n");
466 }
467
468 sub literal {
469 my $stack = shift;
470 return if $stack->disabled;
471 die "argument expected\n" unless @_;
472 my $line = shift;
473 $stack->print("$line\n");
474 }
475
476 sub include {
477 my $stack = shift;
478 return if $stack->disabled;
479 die "argument expected\n" unless @_;
480 my $filename = File::Spec::_0_8::catpath(File::Spec::_0_8::splitpath(@_));
481 if ($stack->{'dependencies'}) {
482 $stack->visit($filename);
483 } else {
484 main::include($stack, $filename);
485 }
486 }
487
488 sub includesubst {
489 my ($stack, $filename) = @_;
490 return if $stack->disabled;
491 die "argument expected\n" unless $filename;
492 $filename =~ s/@(\w+)@/$stack->get($1, 1)/gose;
493 $filename = File::Spec::_0_8::catpath(File::Spec::_0_8::splitpath($filename));
494 if ($stack->{'dependencies'}) {
495 $stack->visit($filename);
496 } else {
497 main::include($stack, $filename);
498 }
499 }
500
501 sub filter {
502 my $stack = shift;
503 return if $stack->disabled;
504 die "argument expected\n" unless @_;
505 foreach (split(/\s/os, shift)) {
506 $stack->filter($_, 1);
507 }
508 }
509
510 sub unfilter {
511 my $stack = shift;
512 return if $stack->disabled;
513 die "argument expected\n" unless @_;
514 foreach (split(/\s/os, shift)) {
515 $stack->filter($_, 0);
516 }
517 }
518
519
520 ########################################################################
521
522 package filter;
523
524 sub emptyLines {
525 my($stack, $text) = @_;
526 $text = "" if $text eq "\n";
527 return $text;
528 }
529
530 sub spaces {
531 my($stack, $text) = @_;
532 $text =~ s/ +/ /gos; # middle spaces
533 $text =~ s/^ //gos; # start spaces
534 $text =~ s/ (\n?)$/$1/gos; # end spaces
535 return $text;
536 }
537
538 sub slashslash {
539 my($stack, $text) = @_;
540 $text =~ s|//.*?(\n?)$|$1|gos;
541 return $text;
542 }
543
544 sub substitution {
545 my($stack, $text) = @_;
546 $text =~ s/@(\w+)@/$stack->get($1, 1)/gose;
547 return $text;
548 }
549
550 sub attemptSubstitution {
551 my($stack, $text) = @_;
552 $text =~ s/@(\w+)@/$stack->get($1, 0)/gose;
553 return $text;
554 }
555
556 ########################################################################
557
558 ########################################################################
559 # This code is from File::Spec::Unix 0.8.
560 # It is not considered a part of the preprocessor.pl source file
561 # This code is licensed under the same license as File::Spec itself.
562
563 package File::Spec::_0_8;
564
565 use Cwd;
566
567 sub rel2abs {
568 my ($path, $base) = @_;
569 if ( ! File::Spec->file_name_is_absolute( $path ) ) {
570 if ( !defined( $base ) || $base eq '' ) {
571 $base = cwd() ;
572 } elsif ( ! File::Spec->file_name_is_absolute( $base ) ) {
573 $base = rel2abs( $base );
574 } else {
575 $base = File::Spec->canonpath( $base );
576 }
577 $path = File::Spec->catdir( $base, $path );
578 }
579 return File::Spec->canonpath( $path );
580 }
581
582 sub splitdir {
583 return split m|/|, $_[1], -1; # Preserve trailing fields
584 }
585
586 sub splitpath {
587 my ($path, $nofile) = @_;
588
589 my ($volume,$directory,$file) = ('','','');
590
591 if ( $nofile ) {
592 $directory = $path;
593 }
594 else {
595 $path =~ m|^ ( (?: .* / (?: \.\.?\Z(?!\n) )? )? ) ([^/]*) |xs;
596 $directory = $1;
597 $file = $2;
598 }
599
600 return ($volume,$directory,$file);
601 }
602
603 sub catpath {
604 my ($volume,$directory,$file) = @_;
605
606 if ( $directory ne '' &&
607 $file ne '' &&
608 substr( $directory, -1 ) ne '/' &&
609 substr( $file, 0, 1 ) ne '/'
610 ) {
611 $directory .= "/$file" ;
612 }
613 else {
614 $directory .= $file ;
615 }
616
617 return $directory ;
618 }
619
620 sub abs2rel {
621 my($path,$base) = @_;
622
623 # Clean up $path
624 if ( ! File::Spec->file_name_is_absolute( $path ) ) {
625 $path = rel2abs( $path ) ;
626 }
627 else {
628 $path = File::Spec->canonpath( $path ) ;
629 }
630
631 # Figure out the effective $base and clean it up.
632 if ( !defined( $base ) || $base eq '' ) {
633 $base = cwd();
634 }
635 elsif ( ! File::Spec->file_name_is_absolute( $base ) ) {
636 $base = rel2abs( $base ) ;
637 }
638 else {
639 $base = File::Spec->canonpath( $base ) ;
640 }
641
642 # Now, remove all leading components that are the same
643 my @pathchunks = File::Spec::_0_8::splitdir( $path);
644 my @basechunks = File::Spec::_0_8::splitdir( $base);
645
646 while (@pathchunks && @basechunks && $pathchunks[0] eq $basechunks[0]) {
647 shift @pathchunks ;
648 shift @basechunks ;
649 }
650
651 $path = CORE::join( '/', @pathchunks );
652 $base = CORE::join( '/', @basechunks );
653
654 # $base now contains the directories the resulting relative path
655 # must ascend out of before it can descend to $path_directory. So,
656 # replace all names with $parentDir
657 $base =~ s|[^/]+|..|g ;
658
659 # Glue the two together, using a separator if necessary, and preventing an
660 # empty result.
661 if ( $path ne '' && $base ne '' ) {
662 $path = "$base/$path" ;
663 } else {
664 $path = "$base$path" ;
665 }
666
667 return File::Spec->canonpath( $path ) ;
668 }
669
670 # End code from File::Spec::Unix 0.8.
671 ########################################################################

  ViewVC Help
Powered by ViewVC 1.1.24