#!/usr/bin/perl
eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'
    if $running_under_some_shell;
##
##  WMk -- Website META Language Make
##
##  Copyright (c) 1996-2001 Ralf S. Engelschall.
##  Copyright (c) 1999-2001 Denis Barbier.
##
##  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.
##

use lib '/usr/lib/x86_64-linux-gnu/wml';
use lib '/usr/lib/x86_64-linux-gnu/wml';
use lib "/usr/share/wml";
use TheWML::Frontends::Wml::Util qw/ canon_path /;

use 5.014;

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

my $VERSION = "2.12.2";

use Term::Cap;
use Getopt::Long 2.13;
use Cwd;
use File::Find;
use Time::HiRes qw/ stat /;

##
##  INIT
##

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

my $WML = $ENV{'WML'} || '/usr/bin/wml';

my $bold;
my $norm;
my $term;
our $opt_h;
our @opt_A_CUR;
our @opt_F_CUR;
our @opt_x_CUR;
our @opt_X_CUR;
our $opt_o_CUR;

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 recursively\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 "  -o, --outputfile=PATH   specify the output file(s)\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 ProcessOptions
{
    $Getopt::Long::bundling      = 1;
    $Getopt::Long::getopt_compat = 0;
    local $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",
            "o|outputfile=s@",  "P|prologue=s@",
            "E|epilogue=s@",    "t|settime",
            "p|pass=s@",        "W|passoption=s@",
            "M|depend:s",       "s|safe",
            "v|verbose:i",      "q|quiet",
            "z|mp4h",           "V|version:i",
            "h|help"
        )
        )
    {
        print STDERR "Try `$0 --help' for more information.\n";
        exit(0);
    }
    &usage($0) if ($opt_h);
}

sub error
{
    my ($str) = @_;
    print STDERR "** WMK:Error: $str\n";
    exit(1);
}

#   save argument line
my @ARGVLINE = @ARGV;

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

#   WML options are read from the command line
our @opt_I = ();
our @opt_i = ();
our @opt_D = ();
our $opt_O = '';
our @opt_P = ();
our @opt_E = ();
our $opt_t = 0;
our @opt_p = ();
our @opt_W = ();
our $opt_M = '-';
our $opt_s = 0;
our $opt_v = -1;
our $opt_q = 0;
our $opt_h = 0;
our $opt_V = -1;
our $opt_z = 0;

&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
}
if ($opt_V)
{
    system("$WML -V$opt_V");
    exit(0);
}

#   If the -M was the last option and the user forgot
#   to put `--' to end options, we adjust it.
if ( $opt_M !~ m%^(-|[MD]*)$% && $#ARGV == -1 )
{
    push( @ARGV, $opt_M );
    $opt_M = '';
}

##
##   CREATE WML COMMAND
##

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

sub addquotedarg
{
    my ( $flag, $arg ) = @_;
    return ' -' . $flag . ' "' . &quotearg($arg) . '"';
}

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

my $Oz = '';
$Oz = ' -z' if ($opt_z);

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

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

my $OW = '';
foreach $a (@opt_W) { $OW .= &addquotedarg( 'W', $a ); }

my $OD = '';
foreach $a (@opt_D) { $OD .= &addquotedarg( 'D', $a ); }

my $OP = '';
foreach $a (@opt_P) { $OP .= &addquotedarg( 'P', $a ); }

my $OE = '';
foreach $a (@opt_E) { $OE .= &addquotedarg( 'E', $a ); }

my $OM = '';
$OM = " -M$opt_M" if ( $opt_M ne '-' );

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

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

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

my $OI = '';
foreach $a (@opt_I) { $OI .= &addquotedarg( 'I', $a ); }

my $Oi = '';
foreach $a (@opt_i) { $Oi .= &addquotedarg( 'i', $a ); }

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

my $wml_cmd =
      "$WML -n"
    . $Oq
    . $Oz
    . $Ov
    . $Op
    . $OW
    . $OD
    . $OP
    . $OE
    . $OM
    . $Ot
    . $Os
    . $Or
    . $OI
    . $Oi
    . $OO;
my $wml_ipp =
      "$WML -n -MM"
    . $Oq
    . $Oz
    . $Ov
    . $Op
    . $OW
    . $OD
    . $OP
    . $OE
    . $OM
    . $Ot
    . $Os
    . $Or
    . $OI
    . $Oi
    . $OO;

my $Oo = '';
foreach $a (@opt_o) { $Oo .= ' -o' . $a; }

#   store initial working directory
my $cwd = Cwd::cwd;

##  read $HOME/.wmkrc
my @pwinfo = getpwuid($<);
my $home   = $pwinfo[7];
$home =~ s|/$||;
if ( -f "$home/.wmkrc" )
{
    chdir($home);
    &read_rcfile();
    chdir($cwd);
}

#    this variable is defined in read_rcfile
my $matchF = '';

my @P;

#   set the path to act on
if ( $#ARGV == -1 )
{
    @P = ('.');
}
else
{
    @P = @ARGV;
}
foreach my $p (@P)
{
    if ( -d $p )
    {
        if ($opt_a)
        {
            #
            #   path is a directory and we run recursively
            #
            #   first look into .wmkrc in case -F option is found
            chdir($p);
            &read_rcfile();
            chdir($cwd);

            my @dirs = ();

            sub wanted
            {
                -d $_
                    && ( m#^${matchF}$# && ( $File::Find::prune = 1 )
                    || push( @dirs, $File::Find::name ) );
            }
            File::Find::find( \&wanted, $p );
            my $dirC = '';
            foreach my $dir (@dirs)
            {
                $dir =~ s|\n$||;
                chdir($dir);
                &read_rcfile() if $dir ne $p;
                my @files = &determine_files();
                if ( $#files > -1 )
                {
                    #   a little bit verbosity
                    if ( $dirC ne $dir )
                    {
                        $dirC = $dir;
                        my $dirtxt = canon_path($dir);
                        if ( $dirtxt ne '.' )
                        {
                            print STDERR "${bold}[$dirtxt]${norm}\n";
                        }
                    }
                    foreach my $exec (@opt_x_CUR)
                    {
                        my $rc = system($exec);
                        error("prolog failed: $exec") if $rc != 0;
                    }
                    foreach my $file (@files)
                    {
                        &process_file( "$dir/$file", $dir, $file );
                    }
                    foreach my $exec (@opt_X_CUR)
                    {
                        my $rc = system($exec);
                        error("epilog failed: $exec") if $rc != 0;
                    }
                }
                chdir($cwd);
            }
        }
        else
        {
            #
            #   path is a directory and we run locally
            #
            chdir($p);
            &read_rcfile();
            next if $p =~ m#^${matchF}$#;
            my @files = &determine_files();
            foreach my $exec (@opt_x_CUR)
            {
                my $rc = system($exec);
                error("prolog failed: $exec") if $rc != 0;
            }
            foreach my $file (@files)
            {
                &process_file( "$p/$file", $p, $file );
            }
            foreach my $exec (@opt_X_CUR)
            {
                my $rc = system($exec);
                error("epilog failed: $exec") if $rc != 0;
            }
            chdir($cwd);
        }
    }
    elsif ( -f $p )
    {
        #
        #   path is a file
        #
        next if $p =~ m#^${matchF}$#;

        my ( $dir, $file ) = ( $p =~ m|^(.*?)([^/]+)$| );
        if ($dir)
        {
            chdir($dir);
            &read_rcfile();
            &process_file( $p, $dir, $file );
            chdir($cwd);
        }
        else
        {
            &read_rcfile();
            &process_file( $p, $dir, $file );
        }
    }
    else
    {
        error("path `$p' neither directory nor plain file");
    }
}

#   read .wmkrc files and command-line options
sub read_rcfile
{
    my ( $cwd, $dir, @DIR );
    our @opt_A_SAV = @opt_A;
    our @opt_F_SAV = @opt_F;
    our @opt_x_SAV = @opt_x;
    our @opt_X_SAV = @opt_X;
    our @opt_o_SAV = @opt_o;
    @opt_A_CUR = @opt_A;
    @opt_F_CUR = @opt_F;
    @opt_x_CUR = @opt_x;
    @opt_X_CUR = @opt_X;
    $opt_o_CUR = '';

    if ( not $opt_r )
    {
        ( $cwd = Cwd::cwd ) =~ s|/$||;
        while ($cwd)
        {
            push( @DIR, $cwd );
            $cwd =~ s|/[^/]+$||;
        }
        foreach $dir ( reverse(@DIR) )
        {
            if ( -f "$dir/.wmkrc" )
            {
                open( FP, "<$dir/.wmkrc" )
                    || error("Unable to load $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) || error("Unable to close $dir/.wmkrc: $!");
                @opt_A = ();
                @opt_F = ();
                @opt_x = ();
                @opt_X = ();
                @opt_o = ();
                &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 );

                if ( $#opt_o > -1 )
                {
                    $opt_o_CUR = '-o' . join( ' -o', @opt_o );
                }
            }
        }
    }

    #   Add command-line options
    @opt_A = ();
    @opt_F = ();
    @opt_x = ();
    @opt_X = ();
    @opt_o = ();
    @ARGV  = @ARGVLINE;
    &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 );

    if ( $#opt_o > -1 )
    {
        $opt_o_CUR = '-o' . join( ' -o', @opt_o );
    }

    #    transforms filename wildcards into extended regexp
    if ( $#opt_F_CUR > -1 )
    {
        $matchF = '(' . join( '|', @opt_F_CUR ) . ')';
        $matchF =~ s|\.|\\.|g;
        $matchF =~ s|\?|.|g;
        $matchF =~ s|\*|.*|g;
    }
    else
    {
        $matchF = '';
    }

    #   Restore values
    @opt_A = @opt_A_SAV;
    @opt_F = @opt_F_SAV;
    @opt_x = @opt_x_SAV;
    @opt_X = @opt_X_SAV;
    @opt_o = @opt_o_SAV;
}

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

    #   determine files
    @filesA = glob( join( ' ', @opt_A_CUR ) );
    @filesF = glob( join( ' ', @opt_F_CUR ) );
    %files  = ();
    foreach $fileA (@filesA)
    {
        my $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
    $opts = $Oo;
    if ( $opts eq '' )
    {
        $opts = $opt_o_CUR;
        open( FP, "<$file" ) || error("Unable to load $file: $!");
        $shebang = '';
        while (1)
        {
            $shebang .= <FP>;
            if ( $shebang =~ m|^(.*)\\\s*$|s )
            {
                $shebang = $1;
                next;
            }
            last;
        }
        if ( $shebang =~ m|^#!wml\s+(.+\S)\s*$|is )
        {
            $opts = $1;
        }
        close(FP) || error("Unable to close $file: $!");
    }

    #   expand %DIR and %BASE
    my $base = $file;
    $base =~ s|\.[a-zA-Z0-9]+$||;
    $opts =~ s|%DIR|$dir|sg;
    $opts =~ s|%BASE|$base|sg;

    #   determine default output file
    if ( $opts !~ m|-o| )
    {
        $opts .= " -o ${base}.html";
    }
    $opts =~ s|(\s*)(\S+)|' '.&quotearg($2)|sge;
    $opts =~ s|^\s+||;
    $opts =~ s|\s+$||;

    #   determine if invocation can be skipped
    my $skipable;
    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 )
        {
            my $rc = system("$wml_cmd $opts $file");
            error("Error in WML (rc=$rc)") if $rc != 0;
        }
    }
}

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

    $skipable = 1;
    @IS       = stat($file);
    local ($/) = undef;
    open( DEP, "$wml_ipp -odummy $file |" )
        || error("Unable to exec $wml_ipp: $!");
    $dep = <DEP>;
    close(DEP) || error("Unable to close exec $wml_ipp: $!");
    $dep =~ s/\\\s+/ /sg;

    if ( $dep =~ m|^(.*):\s+(.*?)\s+(.*)$| )
    {
        foreach $incl ( split( /\s+/, $3 ) )
        {
            if ( -f $incl )
            {
                @OS = stat($incl);
                if ( $IS[9] < $OS[9] )
                {    # 9=mtime
                    $IS[9] = $OS[9];
                }
            }
        }
    }

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

#   exit gracefully
exit(0);

##EOF##
__END__

=head1 NAME

WMk - Website META Language Make

=head1 VERSION

2.12.2

=head1 SYNOPSIS

B<wmk>
[B<-a>]
[B<-A> I<WILDMAT>]
[B<-F> I<WILDMAT>]
[B<-x> I<PATH>]
[B<-X> I<PATH>]
[B<-a>]
[B<-f>]
[B<-n>]
[B<-r>]
[I<WML-options>]
[I<path> ...]

B<wmk>
[B<-V>]
[B<-h>]

=head1 DESCRIPTION

This is the high-level frontend to the I<Website META Language> (WML), a free
HTML generation toolkit for Unix, internally consisting of 9 independent
languages.  See wml(1) for more details on WML.

Use this command to run F<wml> on a bunch of F<.wml> files either directly
given on the command line as I<path> or found via directory traversal in
I<path>.

WMk recognizes WML's I<shebang> lines (``C<#!wml> I<options>'') in the F<.wml>
files and automatically adds I<options> to the command line of F<wml> when
invoking it for this particular file.

=head1 OPTIONS

=over 4

=item B<-a>, B<--all>

Specifies that WMk should recursively process B<all> F<.wml> files it finds in
I<path>.

=item B<-A>, B<--accept=>I<WILDMAT>

Accepts (=includes) all files matched by the shell wildcard pattern I<WILDMAT>
for processing. WMk always has a pre-configured ``C<-A *.wml>'' option which
forces it to process all WML files per default.   This option is only used
when I<path> is a directory.

=item B<-F>, B<--forget=>I<WILDMAT>

Forgets (=exclude) all files and directories matched by the shell wildcard
pattern I<WILDMAT> which were previously accepted by option B<-A>.

=item B<-o>, B<--outputfile=>I<PATH>

Specifies output files.  When this flag is used in F<.wmlrc>, the same
flag must be put in F<.wmkrc> to let WMk know when to rebuild these
output files.

=item B<-x>, B<--exec-prolog=>I<PATH>

Executes I<PATH> in the local context of I<path> B<before> the WML commands
are run.  This options is only used when I<path> is a directory.

=item B<-X>, B<--exec-epilog=>I<PATH>

Executes I<PATH> in the local context of I<path> B<after> the WML commands are
run.  This options is only used when I<path> is a directory.

=item B<-f>, B<--force>

Forces the creation of output files. Usually WMk tries to determine if the
input file was really modified and skips WML invocations if the output files
are still up-to-date.

=item B<-n>, B<--nop>

Sets I<no-operation> (nop) where WMk runs as usual but does not actually
invoce the F<wml> commands. Use this option to see what F<wmk> would do.

=item B<-r>, B<--norcfile>

This forces WMk to ignore all F<.wmkrc> and WML to ignore all F<.wmlrc> files.

=item B<-V>, B<--version>

Gives the version identification string of WMk. Use this to determine the
version of a installed WML toolkit.

=item B<-h>, B<--help>

Prints the usage summary page.

=back

All I<WML-options> directly correspond to their counterparts in F<wml>(1)
because they are just forwarded by F<wmk> except the B<-n> and B<-o> options
which are implicitly created by F<wmk> for each F<wml> invocation.

=head1 USER FILES

=over 4

=item F<$HOME/.wmkrc> and F<(../)*.wmkrc>

These files can also contain option strings, one option per line.  One
may use this file to exclude some directories from being searched for
input files

  -F images
  -F templates
   ...

=back

=head1 CAVEAT

Auto-adjusted variables specified as B<-DNAME~PATH> on the F<wmk>
command-line will not necessarily have the same effect as a similar
definition in a F<./.wmlrc> file.  This is because, when processing
sub-directories, F<wmk> changes its working directory to each of those
directories, which can influence the interpolation of such auto-adjusted
variables.  When specified on the command line, such variables are
interpolated with respect to F<wml>'s current working directory at the
time of its invocation.  So, if you wish such variables to be
interpolated relative to F<wmk>'s current working directory at the time
of its invocation, one can work-around this issue by specifying
B<-DNAME~PATH> in a F<.wmlrc> in that directory rather than specifying
it on the F<wmk> command-line.

=head1 AUTHORS

 Ralf S. Engelschall
 rse@engelschall.com
 www.engelschall.com

 Denis Barbier
 barbier@engelschall.com

=head1 SEE ALSO

wml(1), wml_intro(1)

=cut

# vim: ft=perl
