#!/usr/bin/perl

# Simple tool to read symbol definitions from a file and apply those values to
# the given template using the template expander.
#
# $Id: tplexp,v 1.7 2005/09/22 21:37:14 dunx Exp $

use Template;
use strict;

# Help string
my $help = "Usage:\n"
      . "\ttplexp <symbol file> [-t <template file>] [-odir <output dir>]\n"
      . "\t\t[-dir <template dir>] [--help] [-?]\n"
      . "... where <template dir> defaults to '.'\n";
$::templateFile = "";
$::outputDir = "";
$::symbolFile = "";
$::templateDir = ".";

my $arg;
for ($arg = shift; $arg ne ""; $arg = shift)
{
    if      ($arg eq "-t")      { $::templateFile = shift; }
    elsif   ($arg eq "-odir")   { $::outputDir = shift; }
    elsif   ($arg eq "-tdir")   { $::templateDir = shift; }
    elsif   ($arg eq "--help" || $arg eq "-?")
                                { print $help; exit; }
    elsif   ($::symbolFile eq "") { $::symbolFile = $arg; }
}

# if there is no symbol file, then print help instead
if ($::symbolFile eq "")
{
    print $help;
    exit;
}

(my $tokens, my $clumps) = readSymbols($::symbolFile);

# two preconditions which need checking: if there's no template file, we have
# to abort; if there are no symbols, we need to issue a warning.
$::templateFile ne "" || die "*** No template file defined for $::symbolFile.";
if ((keys %$tokens) == 0)
{
    print "+++ No symbols defined in $::symbolFile\n";
}

# add template directory to templateFile
$::templateDir =~ s/([^\/])$/$1\//;
$::templateFile = $::templateDir . $::templateFile;

# setup a couple of useful symbols
if (!exists $$tokens{inputFile})
{
    $$tokens{inputFile} = $::symbolFile;
}

# instantiate Template object.
# note that tplexp does not use any clump handlers - it relies on the nested
# token context approach
my $tplexp = Template->new;
my $output = $tplexp->expandFile($::templateFile, $tokens);
if ($::outputFile eq "")
{
    print $output ."\n";
}
else
{
    # need to sort out directories
    # 1. change to any specific output directory
    # 2. only create subdirectories if there is a specified output directory
    # 3. if no output directory is given, then synthesise the output path from
    #   that of the input file and the output filename
    my $outputFilename = $::outputFile; # default is given location
    if ($::outputDir)
    {
        chdir $::outputDir || die "*** Could not change to output directory $::outputDir";
        my @dirNames = split /[\/\\]/, $::outputFile;
        $outputFilename = pop @dirNames;
        foreach my $dirName (@dirNames)
        {
            if (!chdir $dirName)
            {
                mkdir($dirName, 0777) || die "*** Could not make create directory '$dirName' for path '$::outputFile'";
                chdir $dirName || die "*** Could not change to new directory '$dirName' in path '$::outputFile'";
            }
        }
    }
    else
    {
        # Extract the path components from the input and output
        my $inputPath = "";
        if ($::symbolFile =~ m/\//)
        {
            $::symbolFile =~ m/(.+\/)[^\/]+$/;
            $inputPath = $1;
        }
        my $outputBarename = $outputFilename;
        if ($outputFilename =~ m/\//)
        {
            $outputFilename =~ m/.+\/([^\/]+)$/;
            $outputBarename = $1;
        }
        $outputFilename = $inputPath . $outputBarename;
    }
    open(OUTPUT, '>'.$outputFilename) || die("Could not open $::outputFile: $!");
    print OUTPUT $output;
    close(OUTPUT);
    print "Wrote $outputFilename from $::symbolFile\n"
}

# param:    symbol file
# return:   ref to global symbol context
#           ref to clump data keyed by clump name
sub readSymbols()
{
    my $symbolFile = shift;

    # structures used in parsing the symbol file
    my $docOpen = 0;
    my %clumps = ();   # clump name to nothing much - used only to keep a list
    my %global = ();   # base token context
    my $context = \%global;
    my $contextName = "";  # holds clump name when appropriate
    my @contextStack = [];      # stack of token contexts
    my @contextNameStack = [];  # stack of context names
    my @rowStack = [];          # stack of rows

    my $rows = [];
    my $symbolValid = 1;
    my $symbolName = "";   # symbol being read
    my $symbolValue = "";  # current value of same
    my $evalName = "";     # eval being read
    my $evalValue = "";    # current value of same

    # the following code parses for symbol setting statements using the syntax
    #       #<name>:<value>#
    #... where <value> can be split across several lines.

    # the intention is to support the following syntax (all commands at the
    # beginning of lines for ease of implementation):
    # doc:      #doc:name(string):template(string)#
    # clump:    #clump:name(string)#
    #           #endclump#
    # row:      #row#
    #           #endrow#
    # symbol:   #name:text#
    # eval:     #eval:name(string):text#

    open (SYMBOLS, $symbolFile) || die "*** Cannot open symbol file $symbolFile";
    while (<SYMBOLS>)
    {
        # doc:      #doc:name(string):template(string)#
        if (!$docOpen && m/^#doc:name\(([^)]+)\):template\(([^)]+)\)#$/)
        {
            # look for parameters
            $::outputFile = $1;
            $::templateFile = $2;
            $docOpen = 1;   # not that it ever gets closed...
        }
        # eval:     #eval:name(string):[text]#
        elsif ($evalName eq "" && $symbolValid && m/^#eval:name\((\w+)\):(.*)#$/)
        {
            $evalName = $1;
            $evalValue = $2;
            $$context{$evalName} = eval $evalValue;
            $evalName = "";
            $evalValue = "";
        }
        # eval:     #eval:name(string):[text]
        elsif ($evalName eq "" && $symbolValid && m/^#eval:name\((\w+)\):(.*)$/)
        {
            $evalName = $1;
            $evalValue = $2."\n";  # add NL we've stripped
        }
        # end eval:   text#
        elsif ($evalName ne "" && m/(.*)#$/)
        {
            $evalValue .= $1;

            $$context{$evalName} = eval $evalValue;
            $evalName = "";
            $evalValue = "";
        }
        # clump:    #clump:name(string)#
        elsif ($symbolName eq "" && $symbolValid && m/^#clump:name\((\w+)\)#$/)
        {
            my $name = $1;
            ($name ne "") || die "Unnamed clump at line ".$.;
            $symbolValid = 0;
            # save existing context
            push @contextStack, $context;
            push @contextNameStack, $contextName;
            push @rowStack, $rows;
            $contextName = $name;
            $rows = [];
        }
        #           #endclump#
        elsif ($contextName ne "" && !$symbolValid && m/^#endclump#$/)
        {
            $context = pop @contextStack;
            $$context{$contextName} = $rows;
            $clumps{$contextName}++;    # record clump names
            $rows = pop @rowStack;
            $contextName = pop @contextNameStack;
            $symbolValid = 1;
        }
        # row:      #row#
        elsif ($contextName ne "" && !$symbolValid && m/^#row#$/)
        {
            # create a new context
            $context = {};
            $symbolValid = 1;
        }
        #           #endrow#
        elsif ($contextName ne "" && $symbolValid && m/^#endrow#$/)
        {
            # save current context to row storage and create new one
            push @$rows, $context;
# no point creating one here at all...
#            $context = {};
            $symbolValid = 0;
        }
        # symbol:   #name:[text]#
        elsif ($symbolName eq "" && $symbolValid && m/^#(\w+):(.*)#$/)
        {
            $symbolName = $1;
            $symbolValue = $2;
            $$context{$symbolName} = $symbolValue;
            $symbolName = "";
            $symbolValue = "";
        }
        # symbol:   #name:[text]
        elsif ($symbolName eq "" && $symbolValid && m/^#(\w+):(.*)$/)
        {
            $symbolName = $1;
            $symbolValue = $2."\n"; # add NL we've stripped
        }
        # end symbol:   text#
        elsif ($symbolName ne "" && m/(.*)#$/)
        {
            $symbolValue .= $1;

            $$context{$symbolName} = $symbolValue;
            $symbolName = "";
            $symbolValue = "";
        }
        # any other text goes on either symbol or eval
        elsif ($symbolName ne "")
        {
            $symbolValue .= $_;
        }
        elsif ($evalName ne "")
        {
            $evalValue .= $_;
        }
    }

    return \%global, \%clumps;
}