/js/lib/Socket.IO-node/support/expresso/deps/jscoverage/js/config/preprocessor.pl
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########################################################################