PageRenderTime 389ms CodeModel.GetById 100ms app.highlight 223ms RepoModel.GetById 59ms app.codeStats 0ms

/js/lib/Socket.IO-node/support/expresso/deps/jscoverage/js/config/preprocessor.pl

http://github.com/onedayitwillmake/RealtimeMultiplayerNodeJs
Perl | 671 lines | 533 code | 77 blank | 61 comment | 88 complexity | f785afadd410c142a64779d208299aac MD5 | raw file
  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
 26use strict;
 27
 28# takes as arguments the files to process
 29# defaults to stdin
 30# output to stdout
 31
 32my $stack = new stack;
 33my $marker = '#';
 34
 35# command line arguments
 36my @includes;
 37while ($_ = $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}
 81unshift(@ARGV, '-') unless @ARGV;
 82unshift(@ARGV, @includes);
 83
 84# do the work
 85foreach (@ARGV) { include($stack, $_); }
 86exit(0);
 87
 88########################################################################
 89
 90package main;
 91use File::Spec;
 92use 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
 99sub 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
145sub 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
157sub 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
173sub 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
184package stack;
185
186# condition evaluated just prior to this context was false
187use constant COND_FALSE => 0;
188
189# condition evaluated just prior to this context was true
190use 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)
196use constant COND_COMPLETED => 2;
197
198sub 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
218sub newline {
219    my $self = shift;
220    $self->{'variables'}->{'LINE'}++;
221}
222
223sub 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
230sub 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
237sub 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
244sub 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
257sub 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
267sub 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
279sub pop {
280    my $self = shift;
281    $self->{'conditionState'} = pop(@{$self->{'lastConditionState'}});
282    return pop(@{$self->{'values'}});
283}
284
285sub enabled {
286    my $self = shift;
287    return $self->{'conditionState'} == COND_TRUE;
288}
289
290sub disabled {
291    my $self = shift;
292    return $self->{'conditionState'} != COND_TRUE;
293}
294
295sub 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
302sub expand {
303    my $self = shift;
304    my($line) = @_;
305    $line =~ s/__(\w+)__/$self->get($1)/gose;
306    return $line;
307}
308
309sub 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
321sub 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
331package preprocessor;
332
333sub 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
349sub undef {
350    my $stack = shift;
351    return if $stack->disabled;
352    die "argument expected\n" unless @_;
353    $stack->undefine(@_);
354}
355
356sub 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
368sub 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
380sub 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
422sub else {
423    my $stack = shift;
424    die "argument unexpected\n" if @_;
425    $stack->replace(1);
426}
427
428sub elif {
429    my $stack = shift;
430    die "argument expected\n" unless @_;
431    &if($stack, @_, 1);
432}
433
434sub elifdef {
435    my $stack = shift;
436    die "argument expected\n" unless @_;
437    &ifdef($stack, @_, 1);
438}
439
440sub elifndef {
441    my $stack = shift;
442    die "argument expected\n" unless @_;
443    &ifndef($stack, @_, 1);
444}
445
446sub endif {
447    my $stack = shift;
448    die "argument unexpected\n" if @_;
449    $stack->pop;
450}
451
452sub 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
460sub 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
468sub 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
476sub 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
488sub 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
501sub 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
510sub 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
522package filter;
523
524sub emptyLines {
525    my($stack, $text) = @_;
526    $text = "" if $text eq "\n";
527    return $text;
528}
529
530sub 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
538sub slashslash {
539    my($stack, $text) = @_;
540    $text =~ s|//.*?(\n?)$|$1|gos;
541    return $text;
542}
543
544sub substitution {
545    my($stack, $text) = @_;
546    $text =~ s/@(\w+)@/$stack->get($1, 1)/gose;
547    return $text;
548}
549
550sub 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
563package File::Spec::_0_8;
564
565use Cwd;
566
567sub 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
582sub splitdir {
583    return split m|/|, $_[1], -1;  # Preserve trailing fields
584}
585
586sub 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
603sub 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
620sub 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########################################################################