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

require 5.003;

BEGIN { $^W = 0; } # get rid of nasty warnings

use lib "/usr/lib/wml/perl/lib";
use lib "/usr/lib/wml/perl/lib/m68k-linux/5.004";
use lib "/usr/local/lib/site_perl";
use lib "/usr/local/lib/site_perl/m68k-linux";

use Getopt::Long 2.13;
use IO::Handle 1.15;
use IO::File 1.06;
use Text::BlockParser qw(parseblock);
use File::Find;
use Cwd;


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


#
#   process command line 
#
sub usage {
    print STDERR "Usage: ipp [options] file ...\n";
    print STDERR "\n";
    print STDERR "Options:\n";
    print STDERR "  -D, --define=<name>=<value>  define a variable\n";
    print STDERR "  -S, --sysincludedir=<dir>    add system include directory\n";
    print STDERR "  -I, --includedir=<dir>       add user include directory\n";
    print STDERR "  -s, --sysincludefile=<file>  pre-include system include file\n";
    print STDERR "  -i, --includefile=<file>     pre-include user include file\n";
    print STDERR "  -P, --prolog=<path>          specify one or more prolog filters\n";
    print STDERR "  -m, --mapfile=<file>         use include file mapping table\n";
    print STDERR "  -o, --outputfile=<file>      set output file instead of stdout\n";
    print STDERR "  -v, --verbose                verbosity\n";
    exit(1);
}
$opt_v = 0;
@opt_I = ('.');
@opt_D = ();
@opt_S = ();
@opt_i = ();
@opt_s = ();
@opt_P = (); 
@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@", 
    "P|prolog=s@",
    "m|mapfile=s@", 
    "o|outputfile=s"  )) {
    &usage;
}
&usage if ($#ARGV == -1);


#
#   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 = ();
$outbuf   = '';

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 CanonPath {
    my ($path) = @_;

    $pathL = '';
    while ($path ne $pathL) {
        $pathL = $path;
        $path =~ s|//|/|g;
        $path =~ s|/\./|/|g;
        $path =~ s|/\.$|/|g;
        $path =~ s|^./||g;
        $path =~ s|([^/.][^/.]*)/\.\.||;
    }
    return $path;
}

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

    #
    #   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
    #
    if (not $noid) {
        $id = &CanonPath($file);
        if ($mode eq 'use') {
            return '' if ($INCLUDES{$id} == 1);
        }
        $INCLUDES{$id} = 1;
    }

    #
    #   process the file
    #
    $in = new IO::File;
    &verbose($level, "|");
    &verbose($level, "+-- $file");
    $in->open("<$file");
    $store  = '';
    $out    = '';
    $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;
        #   Use Negative Alternative Value
        $l =~ s/((?!\\).|^)\$\(([a-zA-Z0-9_]+):\*([^\)]+)\)/$arg{$2} eq '' ? $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
            %argO = %arg;
            &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
            $out .= &ProcessFile($cmd, $type, $file, $level+1, 0, %arg);

            #   reset arguments
            %arg = %argO;
        }

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

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

    return $out;
}

#
#   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";
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();
$outbuf .= &ProcessFile('include', "'", $tmpfile, 0, 1, %arg);
unlink($tmpfile);

#
#   process real files
#
foreach $file (@ARGV) {
    #   read input file
    if ($file eq '-') {
        $in = new IO::Handle;
        $in->fdopen(fileno(STDIN), 'r');
        local ($/) = undef;
        $inbuf = <$in>;
        $in->close;
    }
    else {
        $in = new IO::File;
        $in->open($file);
        local ($/) = undef;
        $inbuf = <$in>;
        $in->close;
    }

    #   create temporary working file
    $tmpfile = "/tmp/ipp.$$.tmp";
    $tmp = new IO::File;
    $tmp->open(">$tmpfile");
    print $tmp $inbuf;
    $tmp->close();

    #   apply prolog filters
    foreach $p (@opt_P) {
        $rc = system("$p <$tmpfile >$tmpfile.f && mv $tmpfile.f $tmpfile 2>/dev/null");
        &error("Prolog Filter `$p' failed") if ($rc != 0);
    }

    #   process file via IPP filter
    $outbuf .= &ProcessFile('include', "'", $tmpfile, 0, 1, %arg);

    #   cleanup
    unlink($tmpfile);
}

#
#   Comment Support
#

#   EOL-comments
1 while ($outbuf =~ s/^([ \t]*)#[^\n]*\n//s); # special  case: at begin
$outbuf =~ s/\n[ \t]*#[^\n]*(?=\n)//sg;       # standard case: in the middle
$outbuf =~ s/\n[ \t]*#[^\n]*\n?$/\n/s;        # special  case: at end
$outbuf =~ s/^([ \t]*)\\(#)/$1$2/mg;          # remove escaping backslash

#   Block-comments
$outbuf = parseblock($outbuf, 
                     sub { return '' }, 0,             # just discard the stuff 
                     quotemeta('/*'), quotemeta('*/'), # the delimiters
                     0, 1, '"', "\\", '"');            # the escapes, etc.


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

#   die gracefully
exit(0);

##EOF##
