#!/usr/bin/perl
# <@LICENSE>
# Licensed to the Apache Software Foundation (ASF) under one or more
# contributor license agreements.  See the NOTICE file distributed with
# this work for additional information regarding copyright ownership.
# The ASF licenses this file to you 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;

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-Z0-9_]+)=(.*)$/) { $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) {
  require File::Spec;
  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 "Cannot 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;
  if($defines{'PERL_BIN'} && ($defines{PERL_BIN} ne 'this')) {
    $perl = $defines{'PERL_BIN'};
    unless(-x $perl) {
      warn("No such PERL_BIN: $perl");
    }
  }
  else {
    # use eval so the module is not loaded unless needed; it's slow
    eval 'use Config; $perl = $Config{"perlpath"};';
  }

  # 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 = '';
  }

  $defines{PERL_MAJOR_VER} = sub {
    $] =~ /^(\d\.\d\d\d)/ or die "bad perl ver $]";
    return $1;
  };

  $defines{PLUGIN_POD} = sub {

    # Grab active plugin list
    my @plugin_pod = ();
    foreach my $pre (<rules/*.pre>) {
      if (open(INIT, $pre)) {
        while (<INIT>) {
          if (/^loadplugin\s+(.*?)\s*$/) { push(@plugin_pod, "    $1\n"); }
        }
        close(INIT);
      }
    }
    return join('', sort @plugin_pod);
  };

  my $towrite = '';
  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;
      }
    }

    $towrite .= $_;
  }

  # Sharpbang (#!) replacement (see also ExtUtils::MY->fixin)
  if ($modules{'sharpbang'}) {
    $towrite =~ s/^#![^\n]*perl[^\n]*\n/#!${perl}${perl_taint}${perl_warn}\n/;
  }

  # Variable replacement (do in one invocation)
  if ($modules{'vars'}) {
    # Replace all @@VARS@@
    while ($towrite =~ /\@\@([A-Z][A-Z0-9_]*)\@\@/) {
      my $what = $1;
      my $d = $defines{$what} || '';
      if (ref($d) =~ /^CODE/) { $d = $d->(); }
      $towrite =~ s/\@\@${what}\@\@/$d/g;
    }
  }

  print FOOOUT $towrite;
}