#!/usr/bin/perl -w
#========================================================================
#
# ttree
#
# DESCRIPTION
#   Script for processing all directory trees containing templates.
#   Template files are processed and the output directed to the 
#   relvant file in an output tree.  The timestamps of the source and
#   destination files can then be examined for future invocations 
#   to process only those files that have changed.  In other words,
#   it's a lot like 'make' for templates.
#
# AUTHOR
#   Andy Wardley   <abw@cre.canon.co.uk>
#
# COPYRIGHT
#   Copyright (C) 1996-1999 Andy Wardley.  All Rights Reserved.
#   Copyright (C) 1998-1999 Canon Research Centre Europe Ltd.
#
#   This module is free software; you can redistribute it and/or
#   modify it under the same terms as Perl itself.
#
#------------------------------------------------------------------------
#
# $Id: ttree,v 1.11 1999/10/01 10:56:23 abw Exp $
#
#========================================================================

use strict;
use Template;
use AppConfig qw( :expand );
use File::Copy;
use File::Path;
use File::Basename;


#------------------------------------------------------------------------
# config
#------------------------------------------------------------------------
my $NAME     = "ttree";
my $VERSION  = sprintf("%d.%02d", q$Revision: 1.11 $ =~ /(\d+)\.(\d+)/);
my $HOME     = $ENV{ HOME } || '';
my $RCFILE   = $ENV{"\U${NAME}rc"} || "$HOME/.${NAME}rc";

# create a sample config file
unless (-f $RCFILE) {
    print("Do you want me to create a sample '.ttreerc' file for you?\n",
	  "(file: $RCFILE)   [y/n]: ");
    my $y = <STDIN>;
    if ($y =~ /^y(es)?/i) {
	write_config($RCFILE);
	exit(0);
    }
}

# read configuration file and command line arguments - I need to remember 
# to fix varlist() and varhash() in AppConfig to make this nicer...
my $config   = read_config($RCFILE);
my $dryrun   = $config->nothing;
my $verbose  = $config->verbose || $dryrun;
my $recurse  = $config->recurse;
my $debug    = $config->debug;
my $all      = $config->all;
my $libdir   = $config->lib;
my $ignore   = $config->ignore;
my $copy     = $config->copy;
my $accept   = $config->accept;
my $srcdir   = $config->src
	       || die "Source directory not set (-s)\n";
my $destdir  = $config->dest
	       || die "Destination directory not set (-d)\n";
die "Source and destination directories may not be the same:\n  $srcdir\n"
    if $srcdir eq $destdir;

# get all template_* options from the config and fold keys to UPPER CASE
my %ttopts   = $config->varlist('^template_', 1);
my %ucttopts;
@ucttopts{ map { uc } keys %ttopts } = values %ttopts;

# now create complete parameter hash for creating template processor
my $ttopts   = {
    %ucttopts,
    INCLUDE_PATH => [ @$libdir, '.' ],
    OUTPUT_PATH  => $destdir,
    ERROR        => \&error,
};

my $ttdata = {
    # TODO: this is lava flow...
    'sys' => { 'time' => sub { time } },
};

sub error {
    my $error = join('', @_);
    chomp $error;
    print STDERR "  ! $error\n";
}
$SIG{__WARN__} = \&error;


#------------------------------------------------------------------------
# pre-amble
#------------------------------------------------------------------------
print "$NAME $VERSION (Template Toolkit version $Template::VERSION)\n\n"
    if $verbose;

if ($verbose) {
    local $" = ', ';
    print(STDERR 
	  "      Source: $srcdir\n",
	  " Destination: $destdir\n",
	  "Include Path: [ @$libdir ]\n",
	  "      Ignore: [ @$ignore ]\n",
	  "        Copy: [ @$copy ]\n",
	  "      Accept: [ ", @$accept ? "@$accept" : "*", " ]\n\n");
    print(STDERR "NOTE: dry run, doing nothing...\n")
	if $dryrun;
}
if ($debug) {
    local $" = ', ';
    print STDERR "Template Toolkit configuration:\n";
    foreach (keys %ucttopts) {
	my $val = $ucttopts{$_};
	next unless $val;
	if (ref($val) eq 'ARRAY') {
	    next unless @$val;
	    $val = "[ @$val ]";
	}
	printf STDERR "  %-12s => $val\n", $_;
    }
    print STDERR "\n";
}


#------------------------------------------------------------------------
# main-amble
#------------------------------------------------------------------------

chdir($srcdir) || die "$srcdir: $!\n";

my $template = Template->new($ttopts);

if (@ARGV) {
    # explicitly process files specified on command lines 
    foreach my $file (@ARGV) {
	print "  + $file\n" if $verbose;
	$template->process("$file", $ttdata, $file)
	    || print "  ! ", $template->error(), "\n";
    }
}
else {
    # implicitly process all file in source directory
    process_tree();
}


#------------------------------------------------------------------------
# process_tree($dir)
#
# Walks the directory tree starting at $dir or the current directory
# if unspecified, processing files as found.
#------------------------------------------------------------------------

sub process_tree {
    my $dir = shift;
    my ($file, $path, $check);
    my $target;
    local *DIR;

    opendir(DIR, $dir || '.') || return undef;

    FILE: while (defined ($file = readdir(DIR))) {
	next if $file eq '.' || $file eq '..';
	$path = $dir ? "$dir/$file" : $file;
	next unless -e $path;

	# check against ignore list
	foreach $check (@$ignore) {
	    if ($path =~ /$check/) {
		printf "  - %-32s (ignored, matches /$check/)\n", $file
		    if $verbose;
		next FILE;
	    }
	}
	
	if (-d $path) {
	    if ($recurse) {
		# create target directory if required
		$target = "$destdir/$path";
		unless (-d $target) {
		    mkpath($target) || do { warn("$!\n"); next; }
			unless $dryrun;
		    printf "  + %-32s (created target directory)\n", $path;
		}
		# recurse into directory
		process_tree($path);
	    }
	    else {
		printf "  - %-32s (directory, not recursing)\n", $path
		    if $verbose;
	    }
	}
	else {
	    process_file($path);
	}
    }
    closedir(DIR);
}
	

#------------------------------------------------------------------------
# process_file()
#
# File filtering and processing sub-routine called by process_tree()
#------------------------------------------------------------------------

sub process_file {
    my $file = shift;
    my ($dest, $base, $check, $srctime, $desttime);

    $dest = $destdir ? "$destdir/$file" : $file;
    $base = basename($file);

#    print "proc $file => $dest\n";

    # test modification time of existing destination file
    if (-f $dest && ! $all) {
	$srctime  = ( stat($file)  )[9];
	$desttime = ( stat($dest) )[9];

	if ($desttime > $srctime) {
	    printf "  - %-32s (not modified)\n", $file
		if $verbose;
	    return;
	}
    }
	
    # check against copy list
    foreach $check (@$copy) {
	if ($base =~ /$check/) {
	    printf "  > %-32s (copied, matches /$check/)\n", $file
		if $verbose;
	    copy($file, $dest)
		unless $dryrun;
	    return;
	}
    }

    # check against acceptance list
    if (@$accept) {
	unless (grep { $base =~ /$_/ } @$accept) {
	    printf "  - %-32s (not accepted)\n", $file
		if $verbose;
	    return;
	}
    }

    print "  + $file\n" if $verbose;

    # process file
    $template->process("./$file", $ttdata, $file)
	|| print("  ! ", $template->error(), "\n")
	    unless $dryrun;
}


#------------------------------------------------------------------------
# read_config($file)
#
# Handles reading of config file and/or command line arguments.
#------------------------------------------------------------------------

sub read_config {
    my $file = shift;
    my $config = AppConfig->new({ 
	ERROR => sub { die @_, "\ntry `$NAME --help'\n" }   }, 
	'help|h'      => { ACTION => \&help },
	'src|s=s'     => { EXPAND => EXPAND_ALL },
	'dest|d=s'    => { EXPAND => EXPAND_ALL },
	'lib|l=s@'    => { EXPAND => EXPAND_ALL },
	'cfg|c=s'     => { EXPAND => EXPAND_ALL, DEFAULT => '.' },
	'verbose|v'   => { DEFAULT => 0 },
	'recurse|r'   => { DEFAULT => 0 },
	'nothing|n'   => { DEFAULT => 0 },
	'all|a'       => { DEFAULT => 0 },
        'debug|dbg'   => { DEFAULT => 0 },
	'ignore=s@',
	'copy=s@',
	'accept=s@',
	'template_case|case',
	'template_interpolate|interpolate',
	'template_pre_chomp|pre_chomp|prechomp',
	'template_post_chomp|post_chomp|postchomp',
        'template_pre_process|pre_process|preprocess=s',
        'template_post_process|post_process|postprocess=s',
        'template_start_tag|start_tag|starttag=s',
        'template_end_tag|end_tag|endtag=s',
        'template_tag_style|tag_style|tagstyle=s',
	'template_plugin_base|plugin_base|pluginbase|p=s@',
    );
    # define this option now that we have $config context
    $config->define(
	'file|f=s@'   => { EXPAND => EXPAND_ALL, 
			   ACTION => sub { 
			       my ($state, $item, $file) = @_;
			       $file = $state->cfg . "/$file" 
				   unless $file =~ /^[\.\/]/;
			       $config->file($file) }  
			   }
    );
    # process main config file, then command line args
    $config->file($file);
    $config->args();

    $config;
}


#------------------------------------------------------------------------
# write_config($file)
#
# Writes a sample configuration file to the filename specified.
#------------------------------------------------------------------------

sub write_config {
    my $file = shift;

    open(CONFIG, ">$file") || die "failed to create $file: $!\n";
    print(CONFIG <<END_OF_CONFIG);

# the 'src' option defines the location of the template files that
# you want to process
src = $HOME/websrc/doc

# the 'dest' option specifies where the output should go
dest = $HOME/public_html

# lib tells the processor (via INCLUDE_PATH) where to find any
# template files that may be INCLUDE'd.  You can specify many.
lib = $HOME/websrc/lib
lib = /usr/local/templates/lib

# things that aren't templates and should be ignored
ignore = \\b(CVS|RCS)\\b
ignore = ^#

# things that should be copied rather than processed
copy = \\.png\$ 
copy = \\.gif\$ 

# by default, everything not ignored or copied is accepted; add 'accept'
# lines if you want to filter further. e.g.
# accept = \\.html\$
# accept = \\.atml\$

END_OF_CONFIG

    close(CONFIG);
    print "$file created.  Please edit accordingly and re-run $NAME\n"; 
}


#------------------------------------------------------------------------
# help()
#
# Prints help message and exits.
#------------------------------------------------------------------------

sub help {
    print<<END_OF_HELP;
$NAME $VERSION (Template Toolkit version $Template::VERSION)

usage: $NAME [options] [files]

Options:
   -a      (--all)          Process all files, regardless of modification
   -r      (--recurse)      Recurse into sub-directories
   -n      (--nothing)      Do nothing, just print summary (enables -v)
   -v      (--verbose)      Verbose mode
   -d      (--debug)        Debug mode
   -h      (--help)         This help
   -s DIR  (--src=DIR)      Source directory
   -d DIR  (--dest=DIR)     Destination directory
   -c DIR  (--cfg=DIR)      Location of configuration files
   -l DIR  (--lib=DIR)      Library directory (INCLUDE_PATH)  (multiple)
   -f FILE (--file=FILE)    Read named configuration file     (multiple)

File search specifications (all may appear multiple times):
   --ignore=REGEX           Ignore files matching REGEX
   --copy=REGEX             Copy files matching REGEX
   --accept=REGEX           Process only files matching REGEX 

Additional options to set Template Toolkit configuration items:
   --interpolate            Interpolate '\$var' references in text
   --case                   Case sensitivity of reserved words
   --pre_chomp              Chomp leading whitespace 
   --post_chomp             Chomp trailing whitespace
   --pre_process=TEMPLATE   Use TEMPLATE as header
   --post_process=TEMPLATE  Use TEMPLATE as footer
   --start_tag=STRING       STRING defines start of directive tag
   --end_tag=STRING         STRING defined end of directive tag
   --tag_style=STYLE        Use pre-defined tag STYLE    
   --plugin_base=PACKAGE    Base PACKAGE for plugins            

See 'perldoc ttree' for further information.  Note that earlier versions
of AppConfig (<1.53) may require options of the form '--name=opt' to be 
specified as '-name opt'.

END_OF_HELP

    exit(0);
}

__END__

#------------------------------------------------------------------------
# POD
#

=head1 NAME

ttree - template tree processor

=head1 SYNOPSIS

    ttree [options] [files]

=head1 DESCRIPTION

The F<ttree> script is used to process entire directory trees containing
template files.  The resulting output from processing each file is then 
written to a corresponding file in a destination directory.  The script
compares the modification times of source and destination files (where
they already exist) and processes only those files that have been modified.
In other words, it is the equivalent of 'make' for the Template Toolkit.

It supports a number of options which can be used to configure
behaviour, define locations and set Template Toolkit options.  The
script first reads the F<.ttreerc> configuration file in the HOME
directory, or an alternative file specified in the TTREERC environment
variable.  Then, it processes any command line arguments, including
any additional configuration files specified via the B<-f> (file) option.

A typical F<.ttreerc> file might look like this:
  
    src    = /home/abw/websrc/doc
    dest   = /home/abw/public_html
    lib    = /home/abw/websrc/lib
    lib    = /usr/local/templates/lib
    cfg    = /home/abw/.ttree
    ignore = \b(CVS|RCS)\b
    ignore = ^#
    copy   = \.(gif|png)$ 
    accept = \.[ah]tml$

The B<src> option indicates a directory containing the template files
to be processed.  A list of files may be specified on the command line
and each will be processed in turn, writing the generated output to a
corresponding file in the B<dest> directory.  If no files are
explicitly named then all files in the B<src> directory will be
processed.  The B<-r> (recurse) option will also cause sub-directories
to be searched for files.  A source file is only processed if it has a
later modification time than any corresponding destination file.
Files will always be processed, regardless of modification times, if
they are named explicitly on the command line, or the B<-a> (all)
option is used.

The B<lib> option may be specified any number of times to indicate
directories in which the Template Toolkit should look for other
template files (INCLUDE_PATH) that it may need to INCLUDE or PROCESS,
but don't represent complete documents that should be processed in
their own right (e.g. headers, footers, menu).  The B<cfg> directory
specifies the location of additional configuration files that may be
loaded via the B<-f> option.  

The B<ignore>, B<copy> and B<accept> options are used to specify Perl
regexen to filter file names.  Files that match any of the B<ignore>
options will not be processed.  Remaining files that match any of the
B<copy> regexen will be copied to the destination directory.  Remaining
files that then match any of the B<accept> criteria are then processed
via the Template Toolkit.  If no B<accept> parameter is specified then 
all files will be accepted for processing if not already copied or
 ignored.

Additional options may be used to set Template Toolkit parameters.
For example:

   interpolate        
   post_chomp         
   pre_process  = header
   post_process = footer

See B<ttree --help> for a summary of options.

=head1 AUTHOR

Andy Wardley E<lt>cre.canon.co.ukE<gt>

=head1 REVISION

$Revision: 1.11 $

=head1 COPYRIGHT

Copyright (C) 1996-1999 Andy Wardley.  All Rights Reserved.
Copyright (C) 1998-1999 Canon Research Centre Europe Ltd.

This module is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=head1 SEE ALSO

L<Template|Template>

=cut



