#! /usr/bin/perl -w

use strict;

my @input_files;

sub usage {
    die qq{
You are not calling $0 correctly.
Format: $0 [var=value [var2=value2 [...]]] INPUTFILE OUTPUTFILE

  INPUTFILE -- a readable input file

  OUTPUTFILE -- either a dash ("-") indicating stdout OR the full path to
      an output file.

  [var=value [var2=value2 [...]]] -- a list of variables to set.  These
      variables will be treated as if they had been set as environment
      variables before this script was run.

  This script will read in the contents of the input file, and replace any
  text of the form @[VARNAME] with the respective environment variable.

@_
}
}

sub die_handler {
    # An error occurred.  Send the error message to both stdout and stderr:
    warn @_;

    # Run llcancel to terminate the entire job step:
    if(defined($ENV{LOADL_STEP_ID})) {
        warn "ABORTING JOB VIA LLCANCEL $ENV{LOADL_STEP_ID}\n";
        system('llcancel',$ENV{LOADL_STEP_ID});
        sleep(5);
        warn "Called llcancel.  Job step hasn't aborted yet... ???\n";
    } elsif(defined($ENV{PBS_JOBID})) {
        warn "ABORTING JOB VIA QDEL $ENV{PBS_JOBID}\n";
        system('qdel',$ENV{PBS_JOBID});
        sleep(5);
        warn "Called qdel.  Job step hasn't aborted yet... ???\n";
    } elsif(defined($ENV{JOB_ID})) {
        warn "ABORTING JOB VIA QDEL $ENV{JOB_ID}\n";
        system('qdel',$ENV{JOB_ID});
        sleep(5);
        warn "Called qdel.  Job step hasn't aborted yet... ???\n";
    } else {
        warn "ERROR: Environment variables JOB_ID, PBS_JOBID and LOADL_STEP_ID are not defined.  I cannot abort via qdel or llcancel!  Maybe this process is not part of a SGE, Torque or LoadLeveler job?  Darn.  I guess I'll just exit with status 2 instead.\n";
    }

    # Exit the script with an error message (sent to stdout & stderr)
    exit(2);
}

my %functions=(
    'lc'=>sub { lc($_[0]) },
    'uc'=>sub { uc($_[0]) },
    'len'=>sub { length($_[0]) },
    'trim'=>sub {
        my $val=shift;
        $val=~/\A\s*(.*?)\s*\z/ms;
        $val=$1;
        $val='' unless defined($val);
        return $val;
    }
);

sub apply {
    my $val=shift;
    my $fun1=shift;
    my $morefun=shift;
    my $runme=$functions{$fun1};

    if(defined($runme)) {
        $val=$runme->($val);
        $val='' unless defined($val);
    } else {
        warn "Ignoring unknown function \"$fun1\" -- I only know these: ".join(', ',keys %functions)."\n";
    }
    if($morefun=~/\A\.([A-Za-z0-9_]+)(.*)\z/) {
        return apply($val,$1,$2);
    }
    return $val;
}

sub require_var {
    my $varname=shift();
    if($varname=~/\A([A-Za-z0-9_]+)\.([A-Za-z0-9_]+)(.*)\z/) {
        # This is a variable with requested function calls
        my ($fun1,$morefun);
        ($varname,$fun1,$morefun)=($1,$2,$3);
        my $val=require_var($varname);
        return apply($val,"$fun1","$morefun");
    } else {
        my $val=$ENV{$varname};
        if(!defined($val) ) {
            die "Error in input file \"$input_files[$#input_files]\": the \"$varname\" environment variable is not defined.  Results of call to env:\n".`env`."\nSCRIPT IS ABORTING BECAUSE \$$varname ENVIRONMENT VARIABLE IS NOT SET.\n";
        }
        return $val;
    }
}

sub replace_backslashed( $ ) {
    my $out;
    if($_[0]=~/\A[0-9]/) {
        $out= chr(oct($_[0]));
    } else {
        $out=$_[0];
    }
    return $out;
}

sub replace_vars( $ ) {
    my $text=shift;
    $text=~ s/(?<!\\)\$([a-zA-Z_0-9.]+)/${\require_var($1)}/g;
    $text=~ s/(?<!\\)\$\{([^{}]*)\}/${\var_or_command($1)}/g;
    $text=~ s/\\n/\n/g;
    $text=~ s/\\t/\t/g;
    $text=~ s/\\r/\r/g;
    $text=~ s/\\b/\b/g;
    $text=~ s/\\([0-9]{3}|.)/${\replace_backslashed("$1")}/g;
    return $text;
}

sub require_file( $ ) {
    my $filename=replace_vars(shift());
    open(EMBEDDED_FILE,"<$filename")
        or die "Unable to open file \"$filename\" for reading: $!";
    my $data;
    do {
        local $/;
        $data=<EMBEDDED_FILE>;
    };
    if(!defined($data)) {
        die "Error reading from file \"$filename\": $!";
    }
    close(EMBEDDED_FILE) or die "Error closing input file \"$filename\": $!";
    return $data;
}

sub var_or_command( $ ) {
    my $data=shift;
    $data=~/\A([a-z_A-Z][a-zA-Z_0-9]*)((?:\.[A-Za-z0-9.]+)?)(?:(==|!=|:\+|:-|=|:=|:\?|<|:<|:)(.*))?\z/ms;
    my ($varname,$functions,$operator,$operand)=($1,$2,$3,$4);
    $functions='' unless defined($functions);
    #warn "varname($varname) operator($operator) operand($operand)";
    if(defined($operator) && $operator ne '') {
        $operand='' unless defined($operand);

        my $vartext=$ENV{$varname};
        my $varset=(defined($ENV{$varname}) && $ENV{$varname} ne '');
        if($functions ne '') {
            $vartext='' unless defined($vartext);
            $functions=~/\A\.([A-Z0-9a-z_]+)(.*)\z/;
            my ($fun,$morefun)=($1,$2);
            $vartext=apply($vartext,$fun,$morefun);
        }

        if($operator eq ':+') {
            return $varset ? replace_vars($operand) : '';            
        } elsif($operator eq ':-') {
            return $varset ? $vartext : replace_vars($operand);
        } elsif($operator eq ':') {
            my $val=$vartext;
            $val='' unless defined $val;
            my ($start,$count) = ($operand=~/\A([0-9]+)(?::([0-9]+))?/ms);
            #warn "substr start($start) count($count) of val($val)";
            my $len=length($val);
            $start=0 unless defined($start);
            return '' if($start>=$len);
            $count=length($val)-$start unless defined($count);
            if($start+$count>$len) {
                $count=$len-$start;
            }
            return substr($val,$start,$count);
        } elsif($operator eq '=') {
            $ENV{$varname}=replace_vars($operand);
            return '';
        } elsif($operator eq '==' || $operator eq "!=") {
            # This is the ternary ?: operator.
            my $val=$vartext;
            my ($test,$then,$else) = ($operand=~/\A((?:[^\\\?]|(?:\\\\)*|(?:\\\\)*\\.)*)\?(.*?):((?:[^\\:]|(?:\\\\)*|(?:\\\\)*\\.)*)\z/ms);
            #warn "then($val)==($test) then($then) else($else)";
            $val="" unless defined $val;
            $test="" unless defined($test);
            $test=replace_vars($test);
            $then="" unless defined($then);
            $else="" unless defined($else);
            if($operator eq "==") {
                return replace_vars(  ($val eq $test) ? $then : $else );
            } else {
                return replace_vars(  ($val ne $test) ? $then : $else );
            }
        } elsif($operator eq ':=') {
            $ENV{$varname}=replace_vars($operand) unless $varset;
            return $ENV{$varname};
        } elsif($operator eq ':?') {
            return $vartext if $varset;
            $operand=replace_vars($operand);
            die "$varname: you did not define this variable.  Aborting" if($operand eq '');
            die "$varname: $operand";
        }
    } elsif(defined($varname)) {

        #warn "call require_var($varname$functions)";
        return require_var("$varname$functions");
    }
    die "Don't know what to do with text \"$data\"";
}

sub require_data( $ ) {
    my $data=shift;
    if($data=~/\A<(.*)\z/ms) {
        # This is an instruction to read in a file.
        return require_file($1);
    } elsif($data eq '@') {
        return '@'; # @[@] is replaced with an @
    } elsif($data =~ /\A\#/) {
        if($data=~/\@\[/) {
            die "Found a \@\[ construct nested within a comment (\@\[#...\]).  Aborting";
        }
        return ''; # @[#stuff] is a comment
    } else {
        # This is a variable name, a command or an error.
        return var_or_command($data);
    }
}

sub make_filename( $$ ) {
    my ($dirname,$filename)=@_;
    my $out=$dirname.'/'.$filename;
    $out=~ s://+:/:g; # Remove duplicate /'s
    return $out;
}

# Set up our special error handler which will run llcancel or qdel if
# any errors occur:
$SIG{__DIE__}=\&die_handler;

while($#ARGV>1) {
  $_=shift @ARGV;
  if( /\A([A-Z_a-z][A-Z_a-z0-9.]*)=(.*)\z/ ) {
    $ENV{$1}=$2;
  } else {
    usage "Unable to parse parameter \"$_\".  Aborting";
  }
}

if($#ARGV!=1) {
    die q{
You are not calling $0 correctly.
Format: $0 INPUTFILE OUTPUTFILE

  INPUTFILE -- a readable input file

  OUTPUTFILE -- either a dash ("-") indicating stdout OR the full path to
      an output file.

  This script will read in the contents of the input file, and replace any
  text of the form @[VARNAME] with the respective environment variable.
}
}

my ($infile,$outfile)=@ARGV;

push @input_files,$infile;

my $filecontents;

if($infile ne '-') {
    open(INFILE,"< $infile")
        or die "Unable to open input file \"$infile\" for reading: $!";
}
if($outfile ne '-') {
    open(OUTFILE,"> $outfile")
        or die "Unable to open output file \"$outfile\" for writing: $!";
}

my $line=0;
my @modes=();

sub active {
    return 1 if($#modes<0);
    my $x;
    foreach $x (@modes) {
        return unless $x>0;
    }
    return 1;
}

sub parse_line {
    $line++;

    if($_=~/^\s*\@\*\*\s*if\s+([A-Za-z_][A-Za-z_0-9.]*)\s*==\s*(.*?)\s*$/) {
        # This is a conditional line.
        my ($left,$right)=($1,$2);
        $left=require_var($left);
        $right=replace_vars($right);
        if($left eq $right) {
            push @modes,1;
        } else {
            push @modes,0;
        }
        return;
    } elsif($_=~/^\s*\@\*\*\s*abort\s+(.*)$/) {
        if(active()) {
            die "Found an abort directive on line $line: $1\n";
        }
        return;
    } elsif($_=~/^\s*\@\*\*\s*warn\s+(.*)$/) {
        if(active()) {
            warn replace_vars($1)."\n";
        }
        return;
    } elsif($_=~/^\s*\@\*\*\s*else\s*if\s+([A-Za-z_][A-Za-z_0-9.]*)\s*==\s*(.*?)\s*\z/) {
        my ($left,$right)=($1,$2);
        $left=require_var($left);
        $right=replace_vars($right);
        if($#modes<0) {
            die "Found an elseif without matching if at line $line";
        }
        if($modes[$#modes]==2) {
            die "Found an elseif after an else at line $line";
        } elsif($modes[$#modes]>0) {
            $modes[$#modes]=-1;
        } elsif($modes[$#modes]==0) {
            if($left eq $right) {
                $modes[$#modes]=3;
            } else {
                $modes[$#modes]=0;
            }
        }
        return;
    } elsif($_=~/^\s*\@\*\*\s*else\s*(?:\#.*)?$/) {
        if($#modes<0) {
            die "Found an else without matching if at line $line";
        }
        if($modes[$#modes]!=0) {
            $modes[$#modes]=-1;
        } else {
            $modes[$#modes]=2;
        }
        return;
    } elsif($_=~/^\s*\@\*\*\s*endif\s*(?:\#.*)?$/) {
        if($#modes>=0) {
            pop @modes;
        } else {
            die "Found an endif without matching if at line $line";
        }
        return;
    } elsif($_=~/^\s*\@\*\*\s*insert\s*(\S.*?)\s*$/) {
        if(active()) {
            my $contents=require_file($1);
            if($outfile eq '-') {
                print $contents;
            } else {
                print OUTFILE $contents;
            }
        }
        return;
    } elsif($_=~/^\s*\@\*\*\s*include\s*(\S.*?)\s*$/) {
        if(active()) {
            my @contents=split(/[\r\n]/,require_file($1));
            my $templine=$line;
            my $data;
            $line=0;
            foreach $data(@contents) {
                $_="$data\n";
                parse_line("$data");
            }
            $line=$templine;
            return;
        } else {
            return;
        }
    } elsif($_=~/^\s*\@\*\*.*/) {
        my $chomped=$_;
        chomp $chomped;
        warn "Invalid \@** directive in line \"$chomped\".  Ignoring line.\n";
        return;
    } elsif($#modes>=0) {
        if(!active()) {
            return;
        }
    }
    
    # Replace text of the form @[VARNAME] with the contents of the
    # respective environment variable:
    s/\@\[((?:\n|[^\]])*)\]/${\require_data($1)}/msg;
    if($outfile eq '-') {
        print $_;
    } else {
        print OUTFILE $_;
    }
    if($line>1000000) {
        # Abort at 1,000,000 lines.
        die "Read more than a million lines from the input file.  Something is probably wrong";
    }
}

if($infile ne '-') {
    parse_line() while(<INFILE>);
} else {
    parse_line() while(<STDIN>);
}

if($#modes!=-1) {
    die "Not enough endifs";
}

if($outfile ne '-') {
    close(OUTFILE)
        or die "Error closing output file \"$outfile\": $!";
}
if($infile ne '-') {
    close(INFILE)
        or die "Error closing input file \"$infile\": $!";
}