preprocessor   [plain text]

#!/usr/bin/perl
# <@LICENSE>
# Copyright 2004 Apache Software Foundation
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
#     http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
# </@LICENSE>
#
# This script isn't supposed to be run by hand, it's used by `make` as a pre-
# processor. It currently accepts these options on the command line:
#
#   -M<module>            Enables <module>
#   -D<variable>=<value>  Defines the <variable> to be <value>; if the value
#                         doesn't contain an equal sign, it is interpreted
#                         as a file and all of its lines containing equal
#                         signs are taken as <variable>=<value> pairs
#
# and some more to help with non-UNIX platforms, where command-line input
# and output redirection are not always available:
#
#   -i<file>              Read from input file <file>
#   -o<file>              Write to output file <file>
#
#   -I<dir>               Read from input directory <dir>
#   -O<dir>               Write to output directory <dir>
#   <filename> ...        Process named files from -I<dir> to -O<dir>
#
#   -m<perm>              Use chmod permissions <perm> for files
#
# Those modules are currently implemented:
#   conditional          Comments out every line containing the string
#                        REMOVEFORINST
#   vars                 Replaces variables: upper case strings surrounded
#                        by double at-signs, eg. @@VERSION@@. The values are
#                        taken from the environment and can be overwritten with
#                        the -D switch. Empty/undefined variables are removed.
#   sharpbang            Does some sharpbang (#!) replacement. Uses PERL_BIN and
#                        PERL_WARN.


use strict;
use warnings;

use Config;
use File::Spec;

my %modules = ();
my %defines = ();

my @infiles = ();
my $infile;
my $outfile;
my $indir;
my $outdir;
my $mode;


# Each environment variable counts as an own defined var for us.
foreach (keys %ENV) {
  $defines{$_} = $ENV{$_};
}

foreach (@ARGV) {
  if    (/^-M([a-z]+)$/)       { $modules{$1} = 1; }
  elsif (/^-D([A-Z_]+)=(.*)$/) { $defines{$1} = $2; }
  elsif (/^-D([^=]+)$/)        { read_defs($1); } 
  elsif (/^-i(.+)$/)           { $infile = $1; }
  elsif (/^-o(.+)$/)           { $outfile = $1; }
  elsif (/^-I(.+)$/)           { $indir = $1; }
  elsif (/^-m(.*)$/)           { $mode = '0'.$1; }
  elsif (/^-O(.+)$/)           { $outdir = $1; }
  elsif (/^(.+)$/)             { push (@infiles, $1); }
}

# On Windows, we get -m without an arg.  avoid problems with that
# by just ignoring that switch.
$mode = undef unless $mode;

if (defined ($indir) && defined ($outdir) && scalar @infiles > 0) {
  my $fname;
  while ($fname = shift @infiles) {
    my $in = File::Spec->catfile ($indir, $fname);
    my $out = File::Spec->catfile ($outdir, $fname);
    do_file ($in, $out);
  }
}
elsif (defined ($infile) && defined($outfile)) {
  do_file ($infile, $outfile);
}
else {
  # just do STDIN/STDOUT . Not recommended for portability as
  # it requires "<" and ">" for Makefile to do its work.
  #
  do_stdin();
}


sub read_defs {
  my ($in) = @_;
  open (DEFS, "<$in") or die "Connot open $in: $!";
  foreach (<DEFS>) {
    $_ =~ s/^\s+|\s+$//g;
    next if /^#/;
    next unless /=/;
    my ($var, $val) = split(/\s*=\s*/, $_, 2);
    $var =~ tr/A-Z_//cd;
    $defines{$var} = $val;
  }
  close (DEFS);
}


sub do_file {
  my ($in, $out) = @_;
 
  open (FOOIN,  "<$in")  or die "Cannot open $in: $!";
  open (FOOOUT, ">$out") or die "Cannot open $out: $!";
  
  do_it();
  
  close (FOOIN);
  close (FOOOUT);

  if (defined $mode) {
    chmod (oct $mode, $out) or die "Cannot chmod $mode $out: $!";
  }
}

sub do_stdin {
  open (FOOIN,  "<&STDIN")  or die "Cannot dup stdin: $!";
  open (FOOOUT, ">&STDOUT") or die "Cannot dup stdout: $!";

  do_it();

  close (FOOIN);
  close (FOOOUT);
}


sub do_it {
  # The perlpath can be overwritten via -DPERL_BIN=<perlpath>
  my $perl   = $Config{'perlpath'};
  if($defines{'PERL_BIN'} && ($defines{PERL_BIN} ne 'this')) {
    $perl = $defines{'PERL_BIN'};
    unless(-x $perl) {
      warn("No such PERL_BIN: $perl");
    }
  }

  # Warnings are enabled per default
  my $perl_warn = ' -w';
  # The warnings can be overwritten via -DPERL_WARN=<yes|no>
  if ($defines{'PERL_WARN'} and $defines{'PERL_WARN'} eq 'no') {
    $perl_warn = '';
  }

  # Taint mode is enabled per default except on 5.005
  my $perl_taint = ' -T';
  # The taint mode can be disabled with -DPERL_TAINT=<yes|no>
  if ($defines{'PERL_TAINT'} and $defines{'PERL_TAINT'} eq 'no') {
    $perl_taint = '';
  }

  # Save the Perl Version
  my $perl_version = $];
  if ($defines{PERL_VERSION} && ($defines{PERL_VERSION} ne 'this')) {
    my @v = split(/[^\d]+/, $defines{PERL_VERSION});
    $perl_version = sprintf("%i.%03i%03i", $v[0] || 0, $v[1] || 0, $v[2] || 0);
  }

  my $l = 1;
  while (<FOOIN>) {
    $_ = pack("C0A*", $_);	# turn off UTF8-ness

    # Conditional compiling
    if ($modules{'conditional'}) {
      # DELETE lines carrying the REMOVE_ON_BUILD or (deprecated) REMOVEFORINST tag
      if(/\bREMOVE(?:FORINST|_ON_BUILD)\b/) {
        next;
      }
    }

    # Variable replacement
    if ($modules{'vars'}) {
      # Replace all @@VARS@@
      while (/\@\@([A-Z][A-Z0-9_]*)\@\@/) {
        my $d = $defines{$1} || '';
        s/\@\@$1\@\@/$d/g;
      }
    }

    # Sharpbang (#!) replacement (see also ExtUtils::MY->fixin)
    if ($modules{'sharpbang'} && ($l == 1)) {
      s/^#!.*perl.*$/#!${perl}${perl_taint}${perl_warn}/;
    }

    print FOOOUT $_;
    $l++;
  }
}