#!/usr/bin/perl -w
# 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.
#   bytes                comments out each "use bytes" from the code if the 
#                        code is built with Perl < 5.6.1. Ths pragma is used to 
#                        force byte semantics rather than character semantics 
#                        to work around Unicode bugs in Perl 5.8.0.
#                        Uses PERL_VERSION (Watch out: You have to define old
#                        Perls via eg. PERL_VERSION=5.5.30 (5.005_03))
#   sharpbang            Does some sharpbang (#!) replacement. Uses PERL_BIN and
#                        PERL_WARN.


use strict;
use Config;
use File::Spec;

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

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

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.
if (defined($mode) && $mode eq '0') { undef $mode; }

my $l = 1;
my $fname;
if (defined ($indir) && defined ($outdir) && scalar @infiles > 0) {
  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 (STDIN, "<$in") or die "Cannot open $in: $!";
  open (OUT, ">$out") or die "Cannot open $out: $!";
  select OUT;
  do_stdin();
  close STDIN; close OUT;

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

sub do_stdin {
  # 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 = (($] < 5.006) ? '' : ' -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);
  }

  while (<STDIN>) {
    $_ = 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@@
      s/\@\@([A-Z][A-Z0-9_]*)\@\@/$defines{$1}/g;
    }

    # Comment out use bytes for old Perls
    if ($modules{'bytes'} && ($perl_version < 5.006)) {
      if(/^[^#]*\buse\s+bytes\b/) {
        s/^(\s*)/$1#/;
        s/$/\t##REMOVED_ON_BUILD##/;
      }
    }

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

    print;
    $l++;
  }
}