#!/usr/bin/perl
eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'
    if $running_under_some_shell;
require 5.003;
##
##  IPP -- Include Pre-Processor
##  Copyright (c) 1997 Ralf S. Engelschall, All Rights Reserved. 
##

use lib "/var/tmp/perl-root/usr//lib/wml/perl/lib";
use lib "/var/tmp/perl-root/usr//lib/wml/perl/lib/i386-linux/5.00401";
use lib "/var/tmp/perl-root/usr//lib/wml/perl/lib/site_perl";
use lib "/var/tmp/perl-root/usr//lib/wml/perl/lib/site_perl/i386-linux";

use Getopt::Long 2.12;
use IO::Handle 1.15;
use IO::File 1.06;
use File::Find;
use Cwd;


#
#   help functions
#
sub verbose {
    local($level, $str) = @_;
    if ($opt_v) {
        print STDERR $level x " " . "$str\n";
    }
}
sub error {
    local($str) = @_;
    print STDERR "** IPP:Error: $str\n";
    exit(1);
}
sub warning {
    local($str) = @_;
    print STDERR "** IPP:Warning: $str\n";
}

#
#   process command line 
#
sub usage {
    print STDERR "Usage: ipp [options] file ...\n";
    print STDERR "   where options are\n";
    print STDERR "   -S <dir>   add system include directory\n";
    print STDERR "   -I <dir>   add user include directory\n";
    print STDERR "   -s <file>  pre-include system include file\n";
    print STDERR "   -i <file>  pre-include user include file\n";
    print STDERR "   -m <file>  use include file mapping table\n";
    print STDERR "   -o <file>  set output file instead of stdout\n";
    print STDERR "   -v         verbosity\n";
    exit(1);
}
$opt_v = 0;
@opt_I = (".");
@opt_D = ();
@opt_S = ();
@opt_i = ();
@opt_s = ();
@opt_m = (); 
$opt_o = "-";
$Getopt::Long::bundling = 1;
$Getopt::Long::getopt_compat = 0;
if (not Getopt::Long::GetOptions("v|verbose", 
                                 "S|sysincludedir=s@", 
                                 "D|define=s@", 
                                 "I|includedir=s@", 
                                 "s|sysincludefile=s@", 
                                 "i|includefile=s@", 
                                 "m|mapfile=s@", 
                                 "o|outputfile=s"  )) {
    &usage;
}
if ($#ARGV == -1) {
    &usage;
}


#
#  open output file
#
if ($opt_o eq '-') {
    $out = new IO::Handle;
    $out->fdopen(fileno(STDOUT), "w");
}
else {
    $out = new IO::File;
    $out->open(">$opt_o");
}


#
#   read mapfiles
#
sub read_mapfile {
    my ($MAP, $mapfile) = @_;
    local (*FP);

    open(FP, "<$mapfile");
    while (<FP>) {
        next if (m|^\s*$|);
        next if (m|^\s*#.*$|);
        if (($given, $replace, $actiontype, $actiontext) =
             m|^(\S+)\s+(\S+)\s+\[\s*([SWE])\s*:\s*(.+?)\s*\].*$|) {
            if ($given =~ m|,|) {
                @given = split(/,/, $given);
            }
            else {
                @given = ( $given );
            }
            foreach $given (@given) {
                $MAP->{$given} = {};
                $MAP->{$given}->{REPLACE}    = $replace; 
                $MAP->{$given}->{ACTIONTYPE} = $actiontype;
                $MAP->{$given}->{ACTIONTEXT} = $actiontext;
            }
        }
    }
    close(FP);
}
$MAP = {};
foreach $file (@opt_m) {
    &read_mapfile($MAP, $file);
}


#
#   iterate over the input files
#

%INLCUDES = ();

sub setargs {
    my ($arg, $str) = @_;
    
    return if ($str eq '');
    while ($str) {
        $str =~ s|^\s+||;
        last if ($str eq '');
        if ($str =~ m|^([a-zA-Z][a-zA-Z0-9_]*)="([^"]*)"(.*)$|) {
            $arg->{$1} = $2;
            $str = $3;
        }
        elsif ($str =~ m|^([a-zA-Z][a-zA-Z0-9_]*)=(\S+)(.*)$|) {
            $arg->{$1} = $2;
            $str = $3;
        }
        elsif ($str =~ m|^([a-zA-Z][a-zA-Z0-9_]*)(.*)$|) {
            $arg->{$1} = 1;
            $str = $2;
        }
        else {
            $str = substr($str, 1); # make sure the loop terminates
        }
    }
}

sub mapfile {
    my ($file) = @_;
    my ($replace, $type, $text);

    if ($replace = $MAP->{$file}->{REPLACE}) {
        $type = $MAP->{$file}->{ACTIONTYPE};
        $text = $MAP->{$file}->{ACTIONTEXT};
        if ($type eq 'S') {
            $file = replace;
        }
        elsif ($type eq 'W') {
            &warning("$file: $text");
            $file = $replace;
        }
        else {
            &error("$file: $text");
        }
    }
    return $file;
}

sub ProcessFile {
    my ($out, $delimiter, $file, $level, %arg) = @_;
    my ($in, $found, $line, $type);

    #
    #   search for file
    #
    $found = 0;
    if ($delimiter eq '<') {
        foreach $dir (@opt_S) {
            if (-f "$dir/$file") {
                $file = "$dir/$file";
                $found = 1;
            }
        }
    }
    if ($delimiter eq '<' or $delimiter eq '"') {
        foreach $dir (@opt_I) {
            if (-f "$dir/$file") {
                $file = "$dir/$file";
                $found = 1;
            }
        }
    }
    if ($delimiter eq '<' or $delimiter eq '"' or $delimiter eq "'") {
        if (-f "$file") {
            $found = 1;
        }
    }
    &error("file not found: $file") if not $found;

    #
    #   stop if file was still included some time before
    #
    return if ($INCLUDES{"$delimiter$file"} == 1);
    $INCLUDES{"$delimiter$file"} = 1;

    #
    #   process the file
    #
    $in = new IO::File;
    $in->open("<$file");
    $store = '';
    $line  = 0;
    while ($l = <$in>) {
        $line++;

        #
        #   Variable Interpolation
        #

        #   Indicate Error if Unset
        $l =~ s/((?!\\).|^)\$\(([a-zA-Z0-9_]+):\?\[(.+?)\]\)/$arg{$2} ne '' ? $1.$arg{$2} : &error($3)/ge;
        #   Use Default Values
        $l =~ s/((?!\\).|^)\$\(([a-zA-Z0-9_]+):-([^\)]+)\)/$arg{$2} ne '' ? $1.$arg{$2} : $1.$3/ge;
        #   Assign And Use Default Values
        $l =~ s/((?!\\).|^)\$\(([a-zA-Z0-9_]+):=([^\)]+)\)/$arg{$2} ne '' ? $1.$arg{$2} : $1.($arg{$2}=$3)/ge;
        #   Use Alternative Value
        $l =~ s/((?!\\).|^)\$\(([a-zA-Z0-9_]+):\+([^\)]+)\)/$arg{$2} ne '' ? $1.$3 : $1/ge;
        #   Normal Value
        $l =~ s/((?!\\).|^)\$\(([a-zA-Z0-9_]+)\)/$1.$arg{$2}/ge;
        #   Implicit Variables
        $l =~ s|__LINE__|$line|g;
        $l =~ s|__FILE__|$file|g;
        #   remove one preceding backslash
        $l =~ s/\\(\$\([a-zA-Z0-9_]+.*?\))/$1/g;

        #
        #   ``#include'' and ``#use'' directives
        #

        if (($cmd, $file, $args) = ($l =~ m/^#(use|include)\s+(\S+)(.*)$/)) {
            #   set arguments
            &setargs(\%arg, $args);

            #   do possible argument mapping
            $file = &mapfile($file);

            #   determine raw filename and type
            if ($file =~ m|^(\S+?)::(\S+)$|) {
                $type = "<";
                $file = "$2.$1";
                $file =~ s|::|/|g;
            }
            elsif ($file =~ m|^(['"<])([^'">]+)['">]$|) {
                $type = $1;
                $file = $2;
            }
            else {
                &error("Unknown file-argument syntax: ``$file''");
            }

            #   now recurse down
            &verbose($level, "recursive step-down for file $file");
            &ProcessFile($out, $type, $file, $level+1, %arg);
            &verbose($level, "recursive step-up of file $file");
        }

        #
        #   ``__END__'' feature
        #
        elsif ($l =~ m|^\s*__END__\s*\n?$|) {
            last;
        }

        #
        #   plain text & line continuation feature
        #
        else {
            if ($store ne '') {
                $l =~ s|^\s+||;
            }
            if ($l =~ m|^(.*)\\\s*\n$|) {
                $store .= $1;
                next;
            }
            print $out $store . $l;
            $store = '';
        }
    }
    print $out $store;
    $in->close();
}

#
#   create initial argument vector
#
%arg = ();
foreach $str (@opt_D) {
    if ($str =~ m|^([a-zA-Z][a-zA-Z0-9_]*)="([^"]*)"$|) {
        $arg{$1} = $2;
    }
    elsif ($str =~ m|^([a-zA-Z][a-zA-Z0-9_]*)=(.+)$|) {
        $arg{$1} = $2;
    }
    elsif ($str =~ m|^([a-zA-Z][a-zA-Z0-9_]*)$|) {
        $arg{$1} = 1;
    }
    else {
        &error("Bad argument to option `D': $str");
    }
}

#
#   process the pre-loaded include files
#
$tmpfile = "/tmp/ipp.$$.tmp";
&verbose(0, "creating temporary file $tmpfile for pre-loading");
unlink($tmpfile);
$tmp = new IO::File;
$tmp->open(">$tmpfile");
foreach $file (@opt_s) {
    if ($file =~ m|^(\S+?)::(\S+)(.*)\n$|) {
        $file = "$2.$1";
        $file =~ s|::|/|g;
    }
    print $tmp "#include <$file>\n";
}
foreach $file (@opt_i) {
    if ($file =~ m|^(\S+?)::(\S+)(.*)\n$|) {
        $file = "$2.$1";
        $file =~ s|::|/|g;
        print $tmp "#use $file\n";
    }
    print $tmp "#include \"$file\"\n";
}
$tmp->close();
&ProcessFile($out, "'", $tmpfile, 0, %arg);
unlink($tmpfile);
&verbose(0, "deleting temporary file $tmpfile");

#
#   process real files
#
foreach $file (@ARGV) {
    if ($file eq '-') {
        $file = "/tmp/ipp.$$.tmp";
        unlink($file);
        $tmp = new IO::File;
        $tmp->open(">$file");
        local ($/) = undef;
        $buf = <STDIN>;
        print $tmp $buf;
        $tmp->close();
        &verbose(0, "creating temporary file $file for STDIN data");
        &ProcessFile($out, "'", $file, 0, %arg);
        &verbose(0, "deleting temporary file $file");
        unlink($file);
    }
    else {
        &ProcessFile($out, "'", $file, 0, %arg);
    }
}

#
#  close output file and exit gracefully
#
$out->close();
exit(0);

##EOF##
