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