#!/usr/bin/perl
eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'
    if $running_under_some_shell;
##
##  WMk -- Website META Language Make
##  
##  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";

use Term::Cap;
use Getopt::Long 2.13;
use File::PathConvert;
use Cwd;


##
##  INIT
##

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

eval "\$term = Tgetent Term::Cap { TERM => undef, OSPEED => 9600 }";
if ($@) {
    $bold = '';
    $norm = '';
}
else {
    $bold = $term->Tputs('md', 1, undef);
    $norm = $term->Tputs('me', 1, undef);
}


##
##  PROCESS ARGUMENT LINE
##

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

    print STDERR "Usage: $progname [options] [path ...]\n";
    print STDERR "\n";
    print STDERR "Operation Options (WMk intern):\n";
    print STDERR "  -a, --all               run for all files recusively\n";
    print STDERR "  -A, --accept=WILDMAT    accept files via shell wildcard matching\n";
    print STDERR "  -F, --forget=WILDMAT    forget files which were previously accepted\n";
    print STDERR "  -x, --exec-prolog=PATH  execute a prolog program in local context\n";
    print STDERR "  -X, --exec-epilog=PATH  execute a epilog program in local context\n";
    print STDERR "  -f, --force             force outpout generation\n";
    print STDERR "  -n, --nop               no operation (nop) mode\n";
    print STDERR "  -r, --norcfile          no .wmkrc and .wmlrc files are read\n";
    print STDERR "\n";
    $o = `wml --help 2>&1`;
    $o =~ s|^.+?\n\n||s;
    $o =~ s|^.+?--noshebang.+?\n||m;
    $o =~ s|^.+?--norcfile.+?\n||m;
    $o =~ s|^.+?--outputfile.+?\n||m;
    print STDERR $o;
    exit(1);
}

sub version {
    system("wml -V$opt_V");
    exit(0);
}

#   WMk options
$opt_a = 0;
@opt_A = ('*.wml');
@opt_F = ();
@opt_x = ();
@opt_X = ();
$opt_f = 0;
$opt_n = 0;
$opt_r = 0;

#   WML options
@opt_I = ();
@opt_i = ();
@opt_D = ();
$opt_O = '';
@opt_E = ();
$opt_t = 0;
@opt_p = ();
$opt_s = 0;
$opt_v = -1;
$opt_q = 0;
$opt_V = -1;
$opt_h = 0;

sub ProcessOptions {
    $Getopt::Long::bundling = 1;
    $Getopt::Long::getopt_compat = 0;
    $SIG{'__WARN__'} = sub { 
        print STDERR "WMk:Error: $_[0]";
    };
    if (not Getopt::Long::GetOptions(
            "a|all",
            "A|accept=s@",
            "F|forget=s@",
            "x|exec-prolog=s@",
            "X|exec-epilog=s@",
            "f|force",
            "n|nop",
            "r|norcfile",
            "I|include=s@", 
            "i|includefile=s@", 
            "D|define=s@",
            "O|optimize=i",
            "E|epilogue=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;
}
&ProcessOptions();

#   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
}
&version if ($opt_V);


##
##   CREATE WML COMMAND
##

$Oq = '';
$Oq = ' -q' if ($opt_q);

$Ov = '';
$Ov = ' -v' if ($opt_v == 0);
$Ov = ' -v'.$opt_v if ($opt_v > 0);

$Op = '';
foreach $a (@opt_p) { $Op .= ' -p'.$a; }

$OD = '';
foreach $a (@opt_D) { $OD .= ' -D "'.$a.'"'; }

$OE = '';
foreach $a (@opt_E) { $OE .= ' -E '.$a; }

$Ot = '';
$Ot = ' -t' if ($opt_t);

$Or = '';
$Or = ' -r' if ($opt_r);

$Os = '';
$Os = ' -s' if ($opt_s);

$OI = '';
foreach $a (@opt_I) { $OI .= ' -I '.$a; }

$Oi = '';
foreach $a (@opt_i) { $Oi .= ' -i '.$a; }

$OO = '';
$OO = ' -O'.$opt_O if ($opt_O ne '');

$wml_cmd = 'wml -n'.$Oq.$Ov.$Op.$OD.$OE.$Ot.$Os.$Or.$OI.$Oi.$OO;


##
##   FILESYSTEM PROCESSING
##

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

#   set the path to act on
if ($#ARGV == -1) {
    @P = ( '.' );
}
else {
    @P = @ARGV;
}
foreach $p (@P) {
    if (-d $p) { 
        if ($opt_a) {
            #
            #   path is a directory and we run recursively
            #
            @dirs = `find $p -type d -print`;
            $dirC = '';
            foreach $dir (@dirs) {
                $dir =~ s|\n$||;
                my $cwd = Cwd::cwd;
                chdir($dir);
                @files = &determine_files();
                if ($#files > -1) {
                    #   a little bit verbosity
                    if ($dirC ne $dir) {
                        $dirC = $dir;
                        $dirtxt = &CanonPath($dir);
                        if ($dirtxt ne '.') {
                            print STDERR "${bold}[$dirtxt]${norm}\n";
                        }
                    }
                    foreach $exec (@opt_x_CUR) {
                        $exec =~ s|^tdist|/usr/lib/wml/exec/wml_aux_tdist|;
                        system($exec);
                    }
                    foreach $file (@files) {
                        &process_file("$dir/$file", $dir, $file);
                    }
                    foreach $exec (@opt_X_CUR) {
                        $exec =~ s|^tdist|/usr/lib/wml/exec/wml_aux_tdist|;
                        system($exec);
                    }
                }
                chdir($cwd);
            }
        }
        else {
            #
            #   path is a directory and we run locally
            #
            my $cwd = Cwd::cwd;
            chdir($p);
            @files = &determine_files();
            foreach $exec (@opt_x_CUR) {
                system($exec);
            }
            foreach $file (@files) {
                &process_file("$p/$file", $p, $file);
            }
            foreach $exec (@opt_X_CUR) {
                system($exec);
            }
            chdir($cwd);
        }
    }
    elsif (-f $p) { 
        #
        #   path is a file
        #
        my ($dir, $file) = ($p =~ m|^(.*?)([^/]+)$|);
        my $cwd;
        if ($dir) {
            $cwd = Cwd::cwd;
            chdir($dir);
            &process_file($p, $dir, $file);
            chdir($cwd);
        }
        else {
            &process_file($p, $dir, $file);
        }
    }
    else {
        print STDERR "** WMk:Error: path `$p' neither directory nor plain file\n";
        exit(1);
    }
}

#   determine files to act on
sub determine_files {
    my ($cwd, $reldir, $dir, @DIR, @files, @filesA, @filesF, $fileA, $fileF, %files);

    #   read .wmkrc files
    @opt_A_SAV = @opt_A;
    @opt_F_SAV = @opt_F;
    @opt_x_SAV = @opt_x;
    @opt_X_SAV = @opt_X;
    @opt_A_CUR = @opt_A;
    @opt_F_CUR = @opt_F;
    @opt_x_CUR = @opt_x;
    @opt_X_CUR = @opt_X;
    if (not $opt_r) {
        ($cwd = Cwd::cwd) =~ s|/$||;
        while ($cwd) {
            push(@DIR, $cwd);
            $cwd =~ s|/[^/]+$||;
        }
        foreach $dir (reverse(@DIR)) {
            $reldir = File::PathConvert::abs2rel("$dir");
            if (-f "$dir/.wmkrc") {
                open(FP, "<$dir/.wmkrc");
                @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;
                    push(@ARGV, &split_argv($_));
                }
                close(FP);
                @opt_A = ();
                @opt_F = ();
                @opt_x = ();
                @opt_X = ();
                &ProcessOptions();
                @opt_A_CUR = (@opt_A_CUR, @opt_A);
                @opt_F_CUR = (@opt_F_CUR, @opt_F);
                @opt_x_CUR = (@opt_x_CUR, @opt_x);
                @opt_X_CUR = (@opt_X_CUR, @opt_X);
            }
        }
        @opt_A = @opt_A_SAV;
        @opt_F = @opt_F_SAV;
        @opt_x = @opt_x_SAV;
        @opt_X = @opt_X_SAV;
    }

    #   determine files
    @filesA = glob(join(' ', @opt_A_CUR));
    @filesF = glob(join(' ', @opt_F_CUR));
    %files = ();
    foreach $fileA (@filesA) {
        $ok = 1;
        foreach $fileF (@filesF) {
            if ($fileA eq $fileF) {
                $ok = 0;
                last;
            }
        }
        $files{$fileA} = 1 if $ok;
    }
    @files = sort(keys(%files));

    return @files;
}

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

sub process_file {
    my ($path, $dir, $file) = @_;
    my ($shebang, $opts, $out);
    local (*FP);

    #   determine additional options
    open(FP, "<$file");
    $shebang = '';
    while (1) {
        $shebang .= <FP>;
        if ($shebang =~ m|^(.*)\\\s*$|s) {
            $shebang = $1;
            next;
        }
        last;
    }
    $opts = '';
    if ($shebang =~ m|^#!wml\s+(.+\S)\s*$|is) {
       $opts = $1;
    }
    close(FP);

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

    #   determine output file
    if ($opts !~ m|-o|) {
        $out = $file;
        $out =~ s|\.wml$|.html|;
        if ($opts eq '') {
            $opts = "-o$out";
        }
        else {
            $opts .= " -o$out";
        }
    }

    #   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;
    }
    $opts =~ s|(\s*)(\S+)|' '.&quotearg($2)|sge;
    $opts =~ s|^\s+||;

    #   determine if invocation can be skipped
    if (not $opt_f) {
        my @outfiles = ();
        my $s = $opts;
        $s =~ s|-o\s*["']?(?:[^:]+:(?!:))?([^\s@]+)|push(@outfiles, $1), ''|sge;
        $skipable = &skipable($file, @outfiles);
    }
    else {
        $skipable = 0;
    }
    
    if ($skipable) {
        print STDERR "$wml_cmd $opts $file  (${bold}skipped${norm})\n";
    }
    else {
        print STDERR "$wml_cmd $opts $file\n";
        if (not $opt_n) {
            $rc = system("$wml_cmd $opts $file");
            if ($rc != 0) {
                print STDERR "** WMk:Break: Error in WML (rc=$rc)\n";
                exit(1);
            }
        }
    }
}

#   is file skipable because not newer then
#   any of its output files
sub skipable {
    my ($file, @outfiles) = @_;
    my ($skipable, $outfile);
    my (@IS, @OS);


    $skipable = 1;
    @IS = stat($file);
    foreach $outfile (@outfiles) {
        if (-f $outfile) {
            @OS = stat(_);
            if ($IS[9] > $OS[9]) { # 9=mtime
                $skipable = 0;
                last;
            }
        }
        else {
            $skipable = 0;
            last;
        }
    }
    return $skipable;
}


#   exit gracefully
exit(0);

##EOF##
