#!/usr/bin/perl
eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'
    if $running_under_some_shell;
##
##  WML -- Website META Language
##  
##  Copyright (c) 1996,1997,1998 Ralf S. Engelschall.
##  
##  This program is free software; you can redistribute it and/or modify
##  it under the terms of the GNU General Public License as published by
##  the Free Software Foundation; either version 2 of the License, or
##  (at your option) any later version.
##  
##  This program is distributed in the hope that it will be useful,
##  but WITHOUT ANY WARRANTY; without even the implied warranty of
##  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
##  GNU General Public License for more details.
##  
##  You should have received a copy of the GNU General Public License
##  along with this program; if not, write to
##  
##      Free Software Foundation, Inc.
##      59 Temple Place - Suite 330
##      Boston, MA  02111-1307, USA
##  
##  Notice, that ``free software'' addresses the fact that this program
##  is __distributed__ under the term of the GNU General Public License
##  and because of this, it can be redistributed and modified under the
##  conditions of this license, but the software remains __copyrighted__
##  by the author. Don't intermix this with the general meaning of 
##  Public Domain software or such a derivated distribution label.
##  
##  The author reserves the right to distribute following releases of
##  this program under different conditions or license agreements.
##

require 5.003;

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

$VERSION = "1.6.4 (23-03-1998)";

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";

if ($ENV{'PATH'} !~ m|/usr/bin|) {
    $ENV{'PATH'} = '/usr/bin:'.$ENV{'PATH'};
}

use Getopt::Long 2.13;
use File::Find;
use File::PathConvert;
use IO::File 1.06;
use Term::ReadKey;
use Cwd;

@dow = ( 'Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat' );
@moy = ( 'Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun',
         'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec' );
sub ctime {
    my ($time) = @_;
  
    my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = 
        localtime($time);
    my ($str) = sprintf("%s %s %2d %02d:%02d:%02d 19%s%s",
         $dow[$wday], $moy[$mon], $mday, $hour, $min, $sec, $year, 
         $isdst ?  " DST" : "");
    return $str;
}
sub isotime {
    my ($time) = @_;
  
    my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = 
        localtime($time);
    my ($str) = sprintf("%02d-%02d-19%02d %02d:%02d:%02d",
         $mday, $mon+1, $year, $hour, $min, $sec);
    return $str;
}

sub usage {
    my ($progname) = @_;

    print STDERR "Usage: $progname [options] [inputfile]\n";
    print STDERR "\n";
    print STDERR "Input Options:\n";
    print STDERR "  -I, --include=PATH     adds an include directory\n";
    print STDERR "  -i, --includefile=PATH pre-include a particular include file\n";
    print STDERR "  -D, --define=NAME=STR  define a variable\n";
    print STDERR "  -D, --define=NAME~PATH define an auto-adjusted path variable\n";
    print STDERR "  -n, --noshebang        no shebang-line parsing (usually used by WMk)\n";
    print STDERR "  -r, --norcfile         no .wmlrc files are read\n";
    print STDERR "\n";
    print STDERR "Output Options:\n";
    print STDERR "  -O, --optimize=NUM     specify the output optimization level\n";
    print STDERR "  -o, --outputfile=PATH  specify the output file(s)\n";
    print STDERR "  -P, --prolog=PATH      specify one or more prolog filters\n";
    print STDERR "  -E, --epilog=PATH      specify one or more epilog filters\n";
    print STDERR "  -t, --settime          sets mtime of outputfile(s) to mtime+1 of inputfile\n";
    print STDERR "\n";
    print STDERR "Processing Options:\n";
    print STDERR "  -p, --pass=STR         specify which passed should be run\n";
    print STDERR "  -s, --safe             don't use precompile/inline hacks to speedup processing\n";
    print STDERR "  -v, --verbose[=NUM]    verbose mode\n";
    print STDERR "  -q, --quiet            quiet mode\n";
    print STDERR "\n";
    print STDERR "Giving Feedback:\n";
    print STDERR "  -V, --version[=NUM]    display version and build information\n";
    print STDERR "  -h, --help             display this usage summary\n";
    print STDERR "\n";
    exit(1);
}

sub ProcessOptions {
    $SIG{'__WARN__'} = sub { 
        print STDERR "WML:Error: $_[0]";
    };
    $Getopt::Long::bundling = 1;
    $Getopt::Long::getopt_compat = 0;
    if (not Getopt::Long::GetOptions(
        "I|include=s@", 
        "i|includefile=s@", 
        "D|define=s@",
        "n|noshebang",
        "r|norcfile",
        "O|optimize=i",
        "o|outputfile=s@",
        "P|prolog=s@",
        "E|epilog=s@",
        "t|settime",
        "p|pass=s@",
        "s|speedup",
        "v|verbose:i",
        "q|quiet",
        "V|version:i",
        "h|help"
    )) {
        print STDERR "Try `$0 --help' for more information.\n";
        exit(0);
    }
    &usage($0) if ($opt_h);
    $SIG{'__WARN__'} = undef;
}

#   pre-process argument line for option -r and -v
$opt_r = 0;
$opt_v = -1;
@ARGVLINE = @ARGV;
&ProcessOptions();
@ARGV = @ARGVLINE;

#   reset with defaults (except $opt_r and $opt_v)
@opt_I = ();
@opt_i = ();
@opt_D = ();
$opt_n = 0;
$opt_O = '';
@opt_o = ();
@opt_P = ();
@opt_E = ();
$opt_t = 0;
@opt_p = ();
$opt_s = 0;
$opt_q = 0;
$opt_V = -1;
$opt_h = 0;

#   save argument line
@ARGVLINE = @ARGV;
@ARGV = ();

#   helper function to split argument line
#   the same way Bourne-Shell does:
#   #1: foo=bar quux   => "foo=bar", "quux"
#   #2: "foo=bar quux" => "foo=bar quux"
#   #3: foo="bar quux" => "foo=bar quux"     <-- !!
sub split_argv {
    my ($str) = @_;
    my (@argv) = ();
    my ($r) = '';

    while (1) {
        next if $str =~ s|^"([^"]*)"(.*)$|$r .= $1, $2|e; 
        next if $str =~ s|^'([^']*)'(.*)$|$r .= $1, $2|e; 
        next if $str =~ s|^([^\s"']+)(.*)$|$r .= $1, $2|e;
        if ($str =~ m|^[\s\n]+| || $str eq '') {
            if ($r ne '') {
                push(@argv, $r);
                $r = '';
            }
            $str =~ s|^[\s\n]+||;
            last if ($str eq '');
        }
    }
    return @argv;
}

#   1. process options in WMLOPTS variable
if ($var = $ENV{'WMLOPTS'}) {
    &verbose(2, "Reading WMLOPTS variable");
    $var =~ s|^\s+||;
    $var =~ s|\s+$||;
    @ARGV = ();
    @X = &split_argv($var);
    push(@ARGV, @X);
    &ProcessOptions();
}

##
##  .wmlrc File Parsing
##
if (not $opt_r) {
    @DIR = ();

    #   2. add all parent dirs .wmlrc files for options
    ($cwd = Cwd::cwd) =~ s|/$||;
    while ($cwd) {
        push(@DIR, $cwd);
        $cwd =~ s|/[^/]+$||;
    }

    #   3. add ~/.wmlrc file for options
    @pwinfo = getpwuid($<);
    $home = $pwinfo[7];
    $home =~ s|/$||;
    if (-f "$home/.wmlrc") {
        push(@DIR, $home);
    }
    

    #   now parse these RC files
    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;
    }
    foreach $dir (reverse(@DIR)) {
        $reldir = File::PathConvert::abs2rel("$dir");
        if (-f "$dir/.wmlrc") {
            &verbose(2, "Reading RC file: $dir/.wmlrc\n");
            open(FP, "<$dir/.wmlrc");
            @ARGV = ();
            while (<FP>) {
                next if (m|^\s*\n$|);
                next if (m|^\s*#[#\s]*.*$|);
                s|^\s+||;
                s|\s+$||;
                s|\$([A-Za-z_][A-Za-z0-9_]*)|$ENV{$1}|ge;
                @X = &split_argv($_);
                push(@ARGV, @X);
            }
            close(FP);
            @opt_D_OLD = @opt_D;
            @opt_I_OLD = @opt_I;
            @opt_D = ();
            @opt_I = ();
            &ProcessOptions();
            @opt_D_NEW = @opt_D_OLD;
            @opt_I_NEW = @opt_I_OLD;

            #   adjust -D options
            foreach $d (@opt_D) {
                if ($d =~ m|^([A-Za-z0-9_]+)~(.+)$|) {
                    ($var, $path) = ($1, $2);
                    if ($path !~ m|^/|) {
                        if ($path eq '.') {
                            $path = &CanonPath("$reldir");
                        }
                        else {
                            $path = &CanonPath("$reldir/$path");
                        }
                    }
                    $path = '""' if ($path eq '');
                    $d = "$var=$path";
                    push(@opt_D_NEW, $d);
                    next;
                }
                push(@opt_D_NEW, $d);
            }

            #   adjust -I options
            foreach $path (@opt_I) {
                if ($path !~ m|^/|) {
                    if ($path eq '.') {
                        $path = &CanonPath("$reldir");
                    }
                    else {
                        $path = &CanonPath("$reldir/$path");
                    }
                    $path = '.' if ($path eq '');
                }
                push(@opt_I_NEW, $path);
            }

            @opt_D = @opt_D_NEW;
            @opt_I = @opt_I_NEW;
        }
    }

}

#   4. process the command line options 
@ARGV = @ARGVLINE;
@opt_D_OLD = @opt_D; @opt_D = (); # extra remember -D options from command line
&ProcessOptions();
@opt_D_ADD = @opt_D; @opt_D = @opt_D_OLD;

#   fix the version level
if ($opt_V == 0) {
    $opt_V = 1; # Getopt::Long sets 0 if -V only
}
if ($opt_V == -1) {
    $opt_V = 0; # we operate with 0 for not set
}
if ($opt_V) {
    print STDERR "This is WML Version $VERSION\n";
    print STDERR "Copyright (c) 1996,1997,1998 Ralf S. Engelschall.\n";
    print STDERR "\n";
    print STDERR "This program is distributed in the hope that it will be useful,\n";
    print STDERR "but WITHOUT ANY WARRANTY; without even the implied warranty of\n";
    print STDERR "MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the\n";
    print STDERR "GNU General Public License for more details.\n";
    if ($opt_V > 1) {
        print STDERR "\n";
        print STDERR "Built Environment:\n";
        print STDERR "    Host: ".'m68k-unknown-linux-gnu'."\n";
        print STDERR "    Perl: ".'5.004_04 (/usr/bin/perl)'."\n";
        print STDERR "    User: ".'cts@blizz'."\n";
        print STDERR "    Date: ".'12-Jun-1998'."\n";
        print STDERR "Built Location:\n";
        print STDERR "    Prefix: ".'/usr'."\n";
        print STDERR "    BinDir: ".'/usr/bin'."\n";
        print STDERR "    LibDir: ".'/usr/lib/wml'."\n";
        print STDERR "    ManDir: ".'/usr/man'."\n";
    }
    if ($opt_V > 2) {
        print STDERR "\n";
        print STDERR "Used Perl System:\n";
        print STDERR `/usr/bin/perl -V`;
    }
    exit(0);
}

#   set the input file
$src = $ARGV[0];

#   if no inputfile is given, WML reads from stdin
#   and forces quiet mode
if ($src eq '') {
    $src = '-';
    $opt_q = 1;
}

#   if input is stdin we create a temporary file
$src_istmp = 0;
if ($src eq '-') {
    $src_istmp = 1;
    $src = "/tmp/wml.input.$$.tmp";
    unlink($src);
    open(TMP, ">$src");
    while (<STDIN>) {
        print TMP $_;
    }
    close(TMP);
}

if (not $src_istmp and not -f $src) {
    print STDERR "** WML:Error: input file `$src' not found\n";
    exit(1);
}

#   now adjust -D options from command line
#   relative to path to source file
if (not $src_istmp) {
    $reldir = $src;
    $reldir =~ s,(:?/|^)[^/]+$,,;
    ($cwd = Cwd::cwd) =~ s|/$||;
    $reldir = File::PathConvert::abs2rel($cwd, "$cwd/$reldir");
}
else {
    $reldir = '.';
}
foreach $d (@opt_D_ADD) {
    if ($d =~ m|^([A-Za-z0-9_]+)~(.+)$|) {
        ($var, $path) = ($1, $2);
        if ($path !~ m|^/|) {
            if ($path eq '.') {
                $path = &CanonPath("$reldir");
            }   
            else {
                $path = &CanonPath("$reldir/$path");
            }
        }
        $path = '""' if ($path eq '');
        $d = "$var=$path";
        push(@opt_D, $d);
        next;
    }
    push(@opt_D, $d);
}


#   5. process the options from the pseudo-shebang line
if (not $opt_n) {
    open(TMP, "<$src");
    $shebang = '';
    while (1) {
        $shebang .= <TMP>;
        if ($shebang =~ m|^(.*)\\\s*$|s) {
            $shebang = $1;
            next;
        }
        last;
    }
    close(TMP);
    if ($shebang =~ m|^#!wml\s+(.+\S)\s*$|is) {
        $opts = $1;

        #   expand %DIR and %BASE
        my ($dir, $base);
        if ($src =~ m|^(.+)/([^/]+)$|) {
            ($dir, $base) = ($1, $2);
        }
        else {
            ($dir, $base) = ('.', $src);
        }
        $base =~ s|\.[a-zA-Z0-9]+$||;
        $opts =~ s|%DIR|$dir|sg;
        $opts =~ s|%BASE|$base|sg;

        #   split opts into arguments and process them
        if ($opts =~ m|\s+|) {
            @ARGV = split(/\s+/, $opts);
        }
        else {
            @ARGV = ( $opts );
        }
        &ProcessOptions();
    }
}

#   fix the verbose level
if ($opt_v == 0) {
    $opt_v = 1; # Getopt::Long sets 0 if -v only
}
if ($opt_v == -1) {
    $opt_v = 0; # we operate with 0 for not set
}

sub verbose {
    my ($level, $str) = @_;

    if ($opt_v >= $level) {
        print STDERR "** WML:Verbose: $str";
    }
}

sub dosystem {
    my ($cmd) = @_;
    my ($rc);

    &verbose(2, "system: $cmd\n");
    $rc = system($cmd);
    return $rc;
}

sub precompile {
    my ($name, $in) = @_;
    my ($error, $func);

    $error = '';
    local $SIG{'__WARN__'} = sub { $error .= $_[0]; };
    local $SIG{'__DIE__'};

    $in =~ s|exit(\s*\(.*?\))|return$1|sg;
    eval("package $name; \$main = sub { \@ARGV = \@_; ".$in."; return 0; }; package main;");
    $error = "$@" if ($@);
    eval("\$func = \$${name}::main;");

    if ($error) {
        $@ = $error;
        return ($func, $error);
    }
    else {
        $@ = '';
        return ($func, '');
    }
}

sub dosource {
    my ($prog, $args) = @_;
    my ($rc, $fp, $src, @argv, $pkgname);

    &verbose(2, "source: $prog $args\n");
    &verbose(9, "loading: $prog\n");
    $pkgname = $prog;
    $pkgname =~ s|^.*/([^/]+)$|$1|;
    if ($prog !~ m|^/|) {
        foreach $p (split(/:/, $ENV{'PATH'})) {
            if (-f "$p/$prog") {
                $prog = "$p/$prog";
                last;
            }
        }
    }
    $fp = new IO::File;
    $fp->open($prog) || die "cannot load $prog";
    $src = '';
    while (<$fp>) {
        $src .= $_;
    }
    $fp->close;
    &verbose(9, "loading: succeeded with $prog (".length($src)." bytes)\n");

    &verbose(9, "precompiling script: pkgname=$pkgname\n");
    ($func, $error) = &precompile($pkgname, $src);
    if ($error ne '') {
        &verbose(9, "precompiling script: error: $error\n");
    }
    else {
        &verbose(9, "precompiling script: succeeded\n");
    }

    &verbose(9, "splitting from args: $args\n");
    @argv = ();
    while ($args) {
        redo if $args =~ s|^\s*(-[a-zA-Z0-9]\S+)|push(@argv, $1), ''|iges;
        redo if $args =~ s|^\s*(-[a-zA-Z0-9])|push(@argv, $1), ''|iges;
        redo if $args =~ s|^\s*"([^"]*)"|push(@argv, $1), ''|iges;
        redo if $args =~ s|^\s*'([^']*)'|push(@argv, $1), ''|iges;
        redo if $args =~ s|^\s*(\S+)|push(@argv, $1), ''|iges;
        redo if $args =~ s|^\s+$|''|iges;
    }
    &verbose(9, "splitting to argv: ".join("|", @argv)."\n");

    &verbose(9, "running script\n");
    $rc = &{$func}(@argv);
    &verbose(9, "running script: rc=$rc\n");

    return $rc;
}

$PROTECT_COUNTER = 0;
%PROTECT_STORAGE = ();

sub protect {
    my ($file, $pass) = @_;
    my ($fp, $data, $prefix, $arg, $body, $key, $ps, $pe);

    $fp = new IO::File;
    $fp->open("<$file") || die "cannot load $file for protection";
    $data = '';
    while (<$fp>) {
        $data .= $_;
    }
    $fp->close;
    $fp->open(">$file") || die "cannot load $file for protection";
    while ($data =~ m|^(.*?)<protect(.*?)>(.*?)</protect>(.*)$|is) {
        ($prefix, $arg, $body, $data) = ($1, $2, $3, $4);
        if ($arg =~ m|pass=(\d)-(\d)|) {
            ($ps, $pe) = ($1, $2);
        }
        elsif ($arg =~ m|pass=(\d)-|) {
            ($ps, $pe) = ($1, 9);
        }
        elsif ($arg =~ m|pass=-(\d)|) {
            ($ps, $pe) = (1, $1);
        }
        elsif ($arg =~ m|pass=(\d)|) {
            ($ps, $pe) = ($1, $1);
        }
        else {
            ($ps, $pe) = (1, 9);
        }
        if ($ps <= $pass && $pass <= $pe) {
            $fp->print($prefix);
            $key = sprintf("%06d", $PROTECT_COUNTER++);
            $PROTECT_STORAGE{$key} = { PS => $ps, PE => $pe, BODY => $body };
            $fp->print("-=P[$key]=-");
        }
        else {
            $fp->print($prefix."<protect".$arg.">".$body."</protect>");
        }
    }
    $fp->print($data);
    $fp->close;
}

sub unprotect {
    my ($file, $pass) = @_;
    my ($fp, $data, $prefix, $key, $s);

    $fp = new IO::File;
    $fp->open("<$file") || die "cannot load $file for unprotection";
    $data = '';
    while (<$fp>) {
        $data .= $_;
    }
    $fp->close;
    $fp->open(">$file") || die "cannot load $file for unprotection";
    while ($data =~ m|^(.*?)-=P\[(\d+)\]=-(.*)$|is) {
        ($prefix, $key, $data) = ($1, $2, $3);
        $s = $PROTECT_STORAGE{$key};
        if ($pass >= $s->{PE}) {
            $fp->print($prefix);
            $fp->print($s->{BODY});
            $PROTECT_STORAGE{$key} = undef;
        }
        else {
            $fp->print($prefix."-=P[$key]=-");
        }
    }
    $fp->print($data);
    $fp->close;
}

sub pass1 {
    my ($opt, $from, $to, $tmp) = @_;
    my ($rc);

    if ($opt_s) {
        $rc = &dosystem("/usr/lib/wml/exec/wml_p1_ipp $opt -o $to $from");
    }
    else {
        $rc = &dosource("/usr/lib/wml/exec/wml_p1_ipp", "$opt -o $to $from");
    }
    return $rc;
}

sub pass2 {
    my ($opt, $from, $to, $tmp) = @_;
    my ($buf, $rc);
    local(*TMP, *TO);

    #   first run the data through Meta-HTML
    #   (always run because no way to determine if not)
    ($cwd = Cwd::cwd) =~ s|/$||;
    $rc = &dosystem("/usr/lib/wml/exec/wml_p2_mhc $opt --set mhtml::relative-prefix '$cwd' $from >$tmp"); 

    #   second, remove asterisks which can be entered
    #   by the user to avoid tag interpolation
    open(TMP, "<$tmp");
    open(TO, ">$to");
    $buf = '';
    while (<TMP>) {
        $buf .= $_;
    }
    $buf =~ s|(<[a-zA-Z][a-zA-Z0-9-_]*)\*([>\s\n\r])|$1$2|sg;
    $buf =~ s|(</[a-zA-Z][a-zA-Z0-9-_]*)\*(>)|$1$2|sg;
    print TO $buf;
    close(TMP);
    close(TO);

    return $rc;
}

sub pass3 {
    my ($opt, $from, $to, $tmp) = @_;
    my ($rc);

    $rc = &dosystem("/usr/lib/wml/exec/wml_p3_eperl $opt -P -k -B '<:' -E ':>' $from >$to");

    return $rc;
}

sub pass4 {
    my ($opt, $from, $to, $tmp) = @_;
    my ($rc);
    local(*TMP, *FROM);

    #   first prepend some essential quoation stuff
    open(TMP, ">$tmp");
    print TMP "m4_define(`m4_noquotes', `m4_changequote(, )m4_dnl')m4_dnl\n";
    print TMP "m4_define(`m4_quotes',   `m4_changequote')m4_dnl\n";
    print TMP "m4_changecom()m4_dnl\n";
    print TMP "m4_noquotes\n"; 
    open(FROM, "<$from");
    while (<FROM>) {
        print TMP $_;
    }
    close(FROM);
    close(TMP);

    #   then run the data through GNU m4
    #   (always run because fast enough!)
    $rc = &dosystem("/usr/lib/wml/exec/wml_p4_gm4 $opt --prefix-builtins <$tmp >$to");

    return $rc;
}

sub pass5 {
    my ($opt, $from, $to, $tmp) = @_;
    my ($rc) = 0;

    if ($opt_s) {
        $rc = &dosystem("/usr/lib/wml/exec/wml_p5_divert $opt -o$to $from");
    }
    else {
        $rc = &dosource("/usr/lib/wml/exec/wml_p5_divert", "$opt -o$to $from");
    }
    return $rc;
}

sub pass6 {
    my ($opt, $from, $to, $tmp) = @_;
    my ($rc) = 0;

    if ($opt_s) {
        $rc = &dosystem("/usr/lib/wml/exec/wml_p6_asubst $opt -o$to $from");
    }
    else {
        $rc = &dosource("/usr/lib/wml/exec/wml_p6_asubst", "$opt -o$to $from");
    }
    return $rc;
}

sub pass7 {
    my ($opt, $from, $to, $tmp) = @_;
    my ($rc);

    if ($opt_s) {
        $rc = &dosystem("/usr/lib/wml/exec/wml_p7_htmlfix $opt -o$to $from");
    }
    else {
        $rc = &dosource("/usr/lib/wml/exec/wml_p7_htmlfix", "$opt -o$to $from");
    }
    return $rc;
}

sub pass8 {
    my ($opt, $from, $to, $tmp) = @_;
    my ($rc);

    if ($opt_s) {
        $rc = &dosystem("/usr/lib/wml/exec/wml_p8_htmlstrip $opt -o $to $from");
    }
    else {
        $rc = &dosource("/usr/lib/wml/exec/wml_p8_htmlstrip", "$opt -o$to $from");
    }
    return $rc;
}

sub pass9 {
    my ($opt, $from, $to, $tmp) = @_;
    my ($rc);

    #   slice contains "package" commands and
    #   other stuff, so we cannot source it.
    $rc = &dosystem("/usr/lib/wml/exec/wml_p9_slice $opt $from");

    return $rc;
}

#
#   predefine some useful variables
#

@pwinfo = getpwuid($<);

$gen_username = $pwinfo[0];
$gen_username =~ s|[\'\$\`\"]||g; # make safe for shell interpolation
$gen_username ||= 'UNKNOWN-USERNAME';

$gen_realname = $pwinfo[6];
$gen_realname =~ s|^([^\,]+)\,.*$|$1|;
$gen_realname =~ s|[\'\$\`\"]||g; # make safe for shell interpolation
$gen_realname ||= 'UNKNOWN-REALNAME';

$gen_hostname = `hostname`;
$gen_hostname =~ s|\n$||;
$gen_hostname ||= 'UNKNOWN-HOSTNAME';

if ($gen_hostname =~ m|^[a-zA-Z0-9_-]+$| and 
    -f "/etc/resolv.conf") {
    $domain = '';
    open(TMP, "</etc/resolv.conf");
    while (<TMP>) {
        if (m|^domain\s+\.?(\S+)|) {
            $domain = $1;
            last;
        }
    }
    close(TMP);
    if ($domain ne '') {
        $gen_hostname = "$gen_hostname.$domain";
    }
}
$gen_ctime = &ctime(time());
$gen_isotime = &isotime(time());

($cwd = Cwd::cwd) =~ s|/$||;
if ($src_istmp) {
    $src_dirname  = $cwd;
    $src_filename = 'STDIN';
    $src_basename = 'STDIN';
    $src_ctime    = $gen_ctime;
    $src_isotime  = $gen_isotime;
    $src_username = $gen_username;
    $src_realname = $gen_realname;
}
else {
    $src_dirname = $cwd;
    $src_filename = $src;
    $src_basename = $src;
    $src_basename =~ s|\.[a-zA-Z0-9]+$||;
    ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
     $atime,$mtime,$ctime,$blksize,$blocks) = stat($src);
    $src_ctime = &ctime($mtime);
    $src_isotime = &isotime($mtime);
    @pwinfo = getpwuid($uid);
    $src_username = $pwinfo[0] || 'UNKNOWN-USERNAME';
    $src_username =~ s|[\'\$\`\"]||g; # make safe for shell interpolation
    $src_realname = $pwinfo[6] || 'UNKNOWN-REALNAME';
    $src_realname =~ s|^([^\,]+)\,.*$|$1|;
    $src_realname =~ s|[\'\$\`\"]||g; # make safe for shell interpolation
}

unshift(@opt_D, "WML_SRC_DIRNAME=\"$src_dirname\"");
unshift(@opt_D, "WML_SRC_FILENAME=\"$src_filename\"");
unshift(@opt_D, "WML_SRC_BASENAME=\"$src_basename\"");
unshift(@opt_D, "WML_SRC_CTIME=\"$src_ctime\"");
unshift(@opt_D, "WML_SRC_ISOTIME=\"$src_isotime\"");
unshift(@opt_D, "WML_SRC_USERNAME=\"$src_username\"");
unshift(@opt_D, "WML_SRC_REALNAME=\"$src_realname\"");
unshift(@opt_D, "WML_GEN_CTIME=\"$gen_ctime\"");
unshift(@opt_D, "WML_GEN_ISOTIME=\"$gen_isotime\"");
unshift(@opt_D, "WML_GEN_USERNAME=\"$gen_username\"");
unshift(@opt_D, "WML_GEN_REALNAME=\"$gen_realname\"");
unshift(@opt_D, "WML_GEN_HOSTNAME=\"$gen_hostname\"");
unshift(@opt_D, "WML_LOC_PREFIX=\"/usr\"");
unshift(@opt_D, "WML_LOC_BINDIR=\"/usr/bin\"");
unshift(@opt_D, "WML_LOC_LIBDIR=\"/usr/lib/wml\"");
unshift(@opt_D, "WML_LOC_MANDIR=\"/usr/man\"");
unshift(@opt_D, "WML_VERSION=\"$VERSION\"");

#
#   generate options
#

#   canonicalize -p option(s)
if ($#opt_p == -1) {
    #   no option means all passes
    @opt_p = ( '1-9' );
}
if (not -s $src) {
    #   on empty input optimize to just use pass 9
    @opt_p = ( '9' );
}
$p = join('', @opt_p);
$p =~ s|,||g;
sub expandrange {
    my ($a, $b) = @_;
    $x = ''; 
    for ($i = $a; $i <= $b; $i++) { 
        $x .= $i;
    }
    return $x;
}
$p =~ s|(\d)-(\d)|&expandrange($1, $2)|sge;
@p = sort {$a <=> $b} (split('', $p));

#   determine includes
$inc = '';
foreach $i (@opt_I) {
    $inc .= " -I $i";
}

#   determine preloads
if (grep(/3/, @p)) {
    #   wml::std::boot is only for 
    #   boostrapping of ePerl (= pass 3) 
    $preload = " -s 'sys/boot.wml'";
}
else {
    $preload = '';
}
foreach $i (@opt_i) {
    if ($i =~ m|^<(.+)>$|) {
        $preload .= " -s '$1'";
    }
    else {
        $preload .= " -i '$i'";
    }
}

#   determine prologs
$prolog = '';
foreach $p (@opt_P) {
    $prolog .= " -P '$p'";
}

$defipp = '';
foreach $d (@opt_D) {
    ($var, $val) = ($d =~ m|^(.+?)="?(.*?)"?$|);
    $defipp .= " \"-D$var=$val\"";
}
$defmhtml = '';
foreach $d (@opt_D) {
    ($var, $val) = ($d =~ m|^(.+?)="?(.*?)"?$|);
    $defmhtml .= " --set \"$var\" \"$val\"";
}
$defeperl = '';
foreach $d (@opt_D) {
    ($var, $val) = ($d =~ m|^(.+?)="?(.*?)"?$|);
    $defeperl .= " \"-d$var=$val\"";
}
$defgm4 = '';
foreach $d (@opt_D) {
    ($var, $val) = ($d =~ m|^(.+?)="?(.*?)"?$|);
    $defgm4 .= " \"-Dm4_$var=$val\"";
}

$out = '';
@outfiles = ();
foreach $o (@opt_o) {
    next if ($o eq '-');

    #   escape options if not quoted but
    #   when shell metachars exists
    sub quotearg {
        my ($arg) = @_;
        if ($arg !~ m|^'.*'$| and $arg !~ m|^".*"$|) {
            if ($arg =~ m|[\[\]()!*?&"']|) {
                $arg =~ s|'|\\'|sg;
                $arg = "'".$arg."'";
            }
        }
        return $arg;
    }

    #   create option
    $out .= " -o ".&quotearg($o);

    #   unquote the filename
    $o =~ s|^"(.*)"$|$1|;
    $o =~ s|^'(.*)'$|$1|;
    
    #   create output file list for epilog filters
    if ($o =~ m|^([_A-Z0-9*~!+u%n\-\\^x()]+):(.+)@(.+)$|) {
        push(@outfiles, $2) if ($2 ne '-');
    }
    elsif ($o =~ m|^([_A-Z0-9*~!+u%n\-\\^x()]+):(.+)$|) {
        push(@outfiles, $2) if ($2 ne '-');
    }
    elsif ($o =~ m|^(.+)@(.+)$|) {
        push(@outfiles, $1) if ($1 ne '-');
    }
    else {
        push(@outfiles, $o) if ($o ne '-');
    }
}

$verbose = '';
if ($opt_v >= 3) {
    $verbose = '-v';
}

$optimize = '';
if ($opt_O ne '') {
    $optimize = "-O$opt_O";
}

$tmp[0] = "/tmp/wml.$$.tmp1";
$tmp[1] = "/tmp/wml.$$.tmp2";
$tmp[2] = "/tmp/wml.$$.tmp3";
$tmp[3] = "/tmp/wml.$$.tmp4";

if (not $src_istmp) {
    $fpin = new IO::File;
    $fpin->open("<$src");
    $fpout = new IO::File;
    $fpout->open(">$tmp[0]");
    while (<$fpin>) {
        $fpout->print($_);
    }
    $fpout->close;
    $fpin->close;

    $from  = $tmp[0];
    $to    = $tmp[1];
    $cnt   = 1;
}
else {
    $from  = $src;
    $to    = $tmp[0];
    $cnt   = 0;
}

$out_istmp = 0;
if ($out eq '') {
    $out = " -o$tmp[3]";
    $out_istmp = 1;
}

$opt_pass1 = "$defipp $verbose -S /usr/lib/wml/include/ $inc $preload $prolog";
$opt_pass2 = "$defmhtml";
$opt_pass3 = "$defeperl";
$opt_pass4 = "$defgm4";
$opt_pass5 = "$verbose";
$opt_pass6 = "$verbose";
$opt_pass7 = "$verbose";
$opt_pass8 = "$verbose $optimize";
$opt_pass9 = "$verbose $out";


$pcnt  = 0;
@prop  = ( "-", "\\", "|", "/");
$last  = '';
$final = 0;
$pager = ($ENV{'PAGER'} || 'more');

#
#   clear out any existing CGI environments because some of our
#   passes (currently Pass 2 and 3) get totally confused by these
#   variables.
#
map { delete $ENV{$_} } qw(
    SERVER_SOFTWARE SERVER_NAME GATEWAY_INTERFACE SERVER_PROTOCOL SERVER_PORT
    REQUEST_METHOD PATH_INFO PATH_TRANSLATED SCRIPT_NAME QUERY_STRING REMOTE_HOST
    REMOTE_ADDR AUTH_TYPE REMOTE_USER REMOTE_IDENT CONTENT_TYPE CONTENT_LENGTH
    HTTP_ACCEPT HTTP_USER_AGENT
);

#
#   MAIN PROCESSING LOOP
#
@TIMES = ();
foreach $p (@p) {
    &verbose(2, "PASS $p:\n");
    print STDERR @prop[$pcnt++ % 4] . "\b" if (not $opt_q); 

    #   run pass
    ($u, $s, $cu, $cs) = times();
    $stime = $u + $s + $cu + $cs;
    &protect($from, $p);
    eval "\$rc = \&pass$p(\$opt_pass$p, \$from, \$to, \$tmp[2]);";
    &unprotect($to, $p) if ($p < 9); # pass 9 is a special case
    ($u, $s, $cu, $cs) = times();
    $etime = $u + $s + $cu + $cs;
    $dtime = $etime-$stime;
    $dtime = 0.01 if ($dtime < 0);
    push(@TIMES, $dtime);
    if ($rc != 0) {
        if (rc % 256 != 0) {
            printf(STDERR "** WML:Break: Error in Pass %d (status=%d, rc=%d).\n", $p, $rc % 256, $rc / 256);
        }
        else {
            printf(STDERR "** WML:Break: Error in Pass %d (rc=%d).\n", $p, $rc / 256);
        }
        unlink($tmp[0]);
        unlink($tmp[1]);
        unlink($tmp[2]);
        unlink($tmp[3]);
        unlink($src) if ($src_istmp);
        exit(1);
    }
    
    #   optionally view current result
    if ($opt_v >= 3 && $p < 9) {
        print STDERR "Want to see result after Pass$p [yNq]: ";
        ReadMode 4;
        $key = ReadKey(0);
        ReadMode 0;
        print STDERR "\n";
        if ($key =~ m|[Yy]|) {
            system("$pager $to");
        }
        elsif ($key =~ m|[qQ]|) {
            printf(STDERR "** WML:Break: Manual Stop.\n");
            exit(1);
        }
    }

    #   step further
    $last  = $to;
    $final = 1 if ($p == 9);
    $from  = $tmp[$cnt % 2];
    $to    = $tmp[($cnt+1) % 2];
    unlink($to);
    $cnt++;
}

if ($last ne '' and not $final) {
    &unprotect($last, 9);
    open(FP, "<$last");
    while (<FP>) {
        print $_;
    }
    close(FP);
}
elsif ($out_istmp) {
    &unprotect($tmp[3], 9);
    open(FP, "<$tmp[3]");
    while (<FP>) {
        print $_;
    }
    close(FP);
}
elsif ($#outfiles > -1) {
    #   unprotect all outputfiles
    foreach $o (@outfiles) {
        &unprotect($o, 9);
    }

    #   optionally set mtime of outputfiles
    #   to mtime of inputfile if inputfile was not STDIN
    if (not $src_istmp and $opt_t) {
        ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
         $atime,$mtime,$ctime,$blksize,$blocks) = stat($src);
         $atime = time();
         foreach $o (@outfiles) {
             utime($atime, $mtime+1, $o);
         }
    }

    #   run epilog filters
    foreach $o (@outfiles) {
        foreach $e (@opt_E) {
            if ($e =~ m|^htmlinfo(.*)|) {
                $e = "/usr/lib/wml/exec/wml_aux_htmlinfo$1";
            }
            elsif ($e =~ m|^weblint(.*)|) {
                $e = "/usr/lib/wml/exec/wml_aux_weblint$1";
            }
            elsif ($e =~ m|^linklint(.*)|) {
                $e = "/usr/lib/wml/exec/wml_aux_linklint$1";
                $e .= " -nocache -one -summary" if ($1 eq '');
            }
            elsif ($e =~ m|^tdist(.*)|) {
                $e = "/usr/lib/wml/exec/wml_aux_tdist$1";
            }
            &verbose(2, "EPILOG: $e $o\n");
            system("$e $o");
        }
    }
}

unlink($tmp[0]);
unlink($tmp[1]);
unlink($tmp[2]);
unlink($tmp[3]);
unlink($src) if ($src_istmp);

($u, $s, $cu, $cs) = times();
$at = $u + $s + $cu + $cs;
$i  = 1;
$pt = 0;
$timestr = '';
foreach $t (@TIMES) {
    $pt += $t;
    if ($i == 2 or $i == 3) {
        $timestr .= sprintf("%5.2f ", $t);
    }
    else {
        $timestr .= sprintf("%4.2f ", $t);
    }
    $i++;
}
$timestr = sprintf("%4.2f | ", $at-$pt) . $timestr;
$timestr .= sprintf("| %6.2f", $at);
&verbose(1, "Processing time (seconds):\n");
&verbose(1, "main |  ipp   mhc   epl  gm4  div asub hfix hstr slic |  TOTAL\n");
&verbose(1, "---- | ---- ----- ----- ---- ---- ---- ---- ---- ---- | ------\n");
&verbose(1, "$timestr\n");

#   exit gracefully
exit(0);

##EOF##
