config/preprocessor.pl

   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 ########################################################################