#!/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 Ralf S. Engelschall, All Rights Reserved. 
##  
##  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.,
##      675 Mass Ave, Cambridge,
##      MA 02139, 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;

$VERSION = "1.4.1 (24-11-1997)";

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 Term::Cap;
use Getopt::Long 2.12;
use File::PathConvert;
use Cwd;


##
##  INIT
##

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

$term = Tgetent Term::Cap { TERM => undef, OSPEED => 9600 };
$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 {
    print STDERR "This is WML/WMk Version $VERSION\n";
    print STDERR "Copyright (c) 1996-1997 Ralf S. Engelschall, All Rights Reserved.\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: ".'i686-pc-linux-gnu'."\n";
        print STDERR "    Perl: ".'5.004_01 (/usr/bin/perl)'."\n";
        print STDERR "    User: ".'jhebert@college.comm.fsu.edu'."\n";
        print STDERR "    Date: ".'Thu Nov 27 00:38:25 EST 1997'."\n";
        print STDERR "Built Location:\n";
        print STDERR "    Prefix: ".'/usr/'."\n";
        print STDERR "    BinDir: ".'/usr//bin'."\n";
        print STDERR "    LibDir: ".'/usr//lib/wml/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);
}

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

#   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`;
            foreach $dir (@dirs) {
                $dir =~ s|\n$||;
                my $cwd = Cwd::cwd;
                chdir($dir);
                @files = &determine_files();
                foreach $exec (@opt_x_CUR) {
                    system($exec);
                }
                foreach $file (@files) {
                    &process_file("$dir/$file", $dir, $file);
                }
                foreach $exec (@opt_X_CUR) {
                    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;
}

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

    #   a little bit verbosity
    if ($dirC ne $dir) {
        $dirC = $dir;
        print STDERR "${bold}[$dir]${norm}\n";
    }

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

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

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