# $Id: Substitute.pm,v 1.6 2002/12/09 18:36:53 abs Exp $

$Text::Substitute::VERSION = '0.15';
##++
##
##     Copyright (c) 2001,2002 David Brownlee. All Rights Reserved
##
##     E-Mail: <abs@mono.org>
##
##     Permission  to  use,  copy, and distribute is hereby granted,
##     providing that the above copyright notice and this permission
##     appear in all copies and in supporting documentation.
##--

=head1 NAME

Text::Substitute - hash based text substitution with conditional

=head1 SYNOPSIS

Text::Substitute can be used to substitute the contents of a hash
into a file or text variable. It includes a limited set of
conditionals, looping, and the ability to include other files. It
was designed primarily for generating web content.

=head1 DESCRIPTION

=head2 Standard Exports

The following routines will be exported into your namespace
if you use the Text::Substitute module:

=over 4

=item substitute(DATA, SUBVARS, OPTS);

substitute() processes then returns DATA. SUBVARS is a reference to a hash
of key/value pairs, and OPTS contains optional parameters, and some return
data.

=item substitute_file(FILE, SUBVARS, OPTS);

substitute_file() reads the contents of FILE (relative to 'templateroot'
and combinations of 'templatepath' and 'templatesearch', and then
calls substitute();

=item substitute_filename(FILE, OPTS);

substitute_filename() returns the filename that substitute_file() would use,
based on the templateroot, templatepath, and templatesearch in OPTS. If no
file is found returns undef.

=back

Substitute tags are of the form ${...}. Note the ':' in all except the
simple ${var} case:

=over 4

=item ${var}	

Replace with the contents of $SUBVARS->{var}.

=item ${include:file}

Include the contents of 'file'. If the file begins with a '/' it starts from
the templateroot and ignores templatepath.

=item ${sinclude:file}

Attempt to include 'file', but fail silently.

=item ${loop:arrayvar}
${endloop:}	

$SUBVARS->{arrayvar} must be a reference to an array.
The data between ${loop:arrayvar} and ${endloop:} is processed for
each entry in the array, with ${loop} set to the loop number
(starting at 0).

If $SUBVARS->{arrayvar} is an array of scalars, then
${loopvar} will be set to each value.

If $SUBVARS->{arrayvar} is an array of references to hashes,
then values in each hash will override the values in $SUBVARS.

Currently ${loop:} can only be nested one level deep.

=item ${if:expr}	
${else:}
${endif:}

If 'expr' is true, include the text between ${if:expr} and
either ${else:} or ${endif:}. If ${if:expr} is false and an
${else:} is present, include the text between ${else:} and
${endif:}. 

'expr' can contain variable names in the form $var. If 'expr'
is a single variable name then it is true is that variable is
not blank.

WARNING: ${if:} statements are 'eval'ed by perl. This allows you to do
just about anything, so do not allow external data into a substituted
file without sanitizing it.

=item ${set:var=value}

Set variable 'var' to 'value'. 'value' can contain any character
except '}'.

=item ${set:var=testvar?setvalue:nosetvalue}

If testvar is not '', set var to setvalue, else to nosetvalue.

=back

The following options can be set in OPTS:

=over 4

=item 'maxincludes'

Maximum includes to permit (default: 100)

=item 'maxsub'

Maximum substitutions to permit (default: 100000)

=item 'specific'

When reading any file, check for a version with .'specific' first.
DEPRECATED - use templatesearch.

=item 'prefix'

When reading any file, check for a file with prefix 'prefix' first.
DEPRECATED - use templatesearch.

=item 'templatedebug'

Display debug information regarding the use of templatepath,
templateroot, and templatesearch.

=item 'templatedir'

Override the template directory within templateroot (default: '.').
DEPRECATED - use templatepath.

=item 'templatepath'

Override the template directory within templateroot (default: '.').
Can be a reference to a search list.

=item 'templateroot'

Set the 'root' for all template operations. (default: 'template')
Can be reference to a search list.

=item 'templatesearch'

Single entry, or reference to list of entries to check for files,
both in substitute_file(), and in any ${include:FILE} operations.
(default: the filename given).

If a search entry contains ${file} then it will be checked by substituting
in the requested file, otherwise it is assumed to be a directory possibly
containing the requested file. For example, to check for files with a
'.bob' extension first, use ('${file}.bob', '.')

Note: Path entries should be permitted to also contain
other ${variable} substitutions. Hopefully this will happen in future.

=item 'unresolved'

Substitute the value given for any unresolved variables.

=back

The following values will be set in OPTS upon return:

=over 4

=item 'numincludes'

The number of includes processed.

=item 'numsub'

The number of substitutions processed (includes ${if:}, ${loop:}, ${include:}
and ${set:}).

=item 'unresolvedlist'

=back

List of unresolved variables.

=over 4

=item 'fail'

If for any reason the substituion fails (invalid include, too many
substitutions, etc) both the returned data and the $OPTS->{fail}
will be set to the failure reason.

=back

Additional notes:

=over 4

=item Nesting of variables is not currently supported.

=item Trailing whitespace up the the next \n after any ${:} tag except
${include:} automatically stripped.

=item Nesting of ${loop:} within ${loop:} beyond one level is not
currently supported

=item The 'expr' parsing for ${if:} needs to be expanded

=back

=cut

package	Text::Substitute;
require	Exporter;
@ISA	= qw(Exporter);
@EXPORT	= qw(substitute substitute_file substitute_filename);
# Do not wrap any of the above lives - will cause issues with serverconf

use strict;
use Cwd;

# perl 5.004_004 does not understand 4 argument substr
sub substr4
    {
    my($tmp);

    $tmp = substr($_[0], $_[1], $_[2]);
    substr($_[0], $_[1], $_[2]) = $_[3];
    $tmp;
    }

sub substitute_file
    {
    my($file, $subvars, $opts) = @_;
    my($data);

    delete $opts->{fail};
    $data = template_read($file, $opts);
    if ($opts->{fail})
	{ return $opts->{fail}; }
    $opts->{file} = $file;
    return(substitute($data, $subvars, $opts));
    }

sub substitute
    {
    my($data, $subvars, $opts) = @_;

    delete $opts->{fail};

    $opts->{file} ||= 'data';
    if (! defined $opts->{maxincludes})
	{ $opts->{maxincludes} = 100 ; }
    if (! defined $opts->{maxsub})
	{ $opts->{maxsub} = 100000 ; }

    $opts->{numincludes} = 0;
    $opts->{numsub} = 0;
    delete $opts->{unresolvedlist};

    return(substitute_process($data, $subvars, $opts));
    }

sub substitute_process
    {
    my($data, $subvars, $opts) = @_;

    my($done, $offset);

    $done = '';
    while( ($offset = index($data, '${')) != -1 ) # }
	{
	$done .= substr4($data, 0, $offset, '');

	# Check if we have a potentially valid sub
	#
	if ($data !~ /\${([\w+]+)(|:([^{}]+))}/s)
	    {
	    $done .= substr4($data, 0, 2, '');
	    next;
	    }

	if (++$opts->{numsub} > $opts->{maxsub})
	    {
	    $opts->{fail} = ">$opts->{maxsub} substitutions at \${$1$2}";
	    return($opts->{fail});
	    }

	my($val);

	if ($2 eq '')	# Standard subvar
	    {
	    $val = $subvars->{$1};
	    if (!defined $val && defined $opts->{unresolved})
		{ $val = ''; }
	    }
	elsif ($1 eq 'include' || $1 eq 'sinclude')
	    {
	    if (++$opts->{numincludes} > $opts->{maxincludes})
		{
		$data = "Too many includes ($opts->{numincludes})\n";
		last;
		}
	    $val = template_read($3, $opts, $1 eq 'sinclude');
	    if ($opts->{fail})
		{ return $opts->{fail}; }
	    }

	elsif ($1 eq 'loop')
	    {
	    my($arrayvar, $loopbody);
	    $arrayvar = $3;
	    if ($data =~ s/^\${loop:[^{}]+}(.*?)\${endloop:}//s)
		{
		$loopbody = $1;
		# Nested loop?
		if ($loopbody =~ /\${loop:[^{}]+}/)
		    {
		    $loopbody .= '${endloop:}';
		    $data =~ s/(.*?)\${endloop:}//s; # Syntax error?
		    $loopbody .= $1;
		    }
		if (ref $subvars->{$arrayvar} eq 'ARRAY')
		    {
		    my(%save, $loop, $loopvar);

		    $loop = 0;
		    $save{loop} = $subvars->{loop};

		    foreach $loopvar (@{$subvars->{$arrayvar}})
			{
			if (ref $loopvar eq 'HASH')
			    {
			    foreach (keys %{$loopvar})
				{
				if (!defined $save{$_})
				    { $save{$_} = $subvars->{$_}; }
				$subvars->{$_} = $loopvar->{$_};
				}
			    }
			else
			    {
			    if (!defined $save{loopvar})
				{ $save{loopvar} = $subvars->{loopvar}; }
			    $subvars->{loopvar} = $loopvar;
			    }
			$subvars->{loop} = $loop;
			$done .= substitute_process($loopbody, $subvars, $opts);
			++$loop;
			foreach (keys %save)
			    { $subvars->{$_} = $save{$_}; }
			}
		    }
		}
	    next;
	    }

	elsif ($1 eq 'if')
	    {
	    my($ifexpr, $ifbody, $elsebody);
	    $ifexpr = $3;
	    if ($data =~ s/^\${if:[^{}]+}(\s*\n|)//s)
		{
		my($nest_depth);
		++$nest_depth;
		$ifbody = '';
		while ($nest_depth && $data =~
		    s/^(\s*\n|)(.*?)\${(if:[^{}]+|endif:|else:)}(\s*\n|)//s)
		    {
		    if (defined $elsebody)
			{ $elsebody .= $2; }
		    else
			{ $ifbody .= $2; }
		    if ($3 eq 'else:')
			{
			if ($nest_depth == 1)
			    {
			    $elsebody = '';
			    next;
			    }
			}
		    elsif ($3 eq 'endif:')
			{
			if (--$nest_depth == 0)
			    { last; }
			}
		    else
			{ ++$nest_depth; }
		    if (defined $elsebody)
			{ $elsebody .= '${'.$3.'}'; }
		    else
			{ $ifbody .= '${'.$3.'}'; }
		    }

		my($res);
                if ($ifexpr =~ /^\s*(!|)\s*\$(\w+)\s*$/s)
                    {
                    $res = (defined $subvars->{$2} && $subvars->{$2} ne ''
                                && $subvars->{$2} ne '0')?1:0;
                    if ($1 eq '!')
                        { $res ^= 1; }
                    }
		else
		    {
		    my($newexpr) = $ifexpr;
		    while ($newexpr =~ /\$(\w+)/s)
			{
			my($val);
			if (defined $subvars->{$1} && $subvars->{$1} ne '')
			    { $newexpr =~ s/\$(\w+)/"$subvars->{$1}"/s; }
			else
			    { $newexpr =~ s/\$(\w+)/''/s; }
			}
		    $res = eval $newexpr;    # XXXX Danger Will Hunting
		    if (!defined $res)
			{
			return $opts->{fail} =
					"Unparsable if ($ifexpr) ($newexpr)";
			}
		    }
		if ($res)
		    { $done .= substitute_process($ifbody, $subvars, $opts); }
		elsif ($elsebody)   
		    { $done .= substitute_process($elsebody, $subvars, $opts); }
		}
	    else
		{ return $opts->{fail} = "Invalid if in '$data'"; }
	    next;
	    }

	elsif ($1 eq 'set')
	    {
	    my($key, $value) = split('=', $3, 2);
	    if (substr($value, 0, 1) eq '$')
		{
		my($opt1, $opt2, $opt1pos, $opt2pos);

		$value = substr($value,1);

		# ${set:aaa=$xxx?yyy:zzz}
		if ( ($opt1pos = index($value, '?')) != -1 &&
				($opt2pos = index($value, ':')) != -1 &&
				$opt2pos > $opt1pos)
		    {
		    $opt2 = substr($value, $opt2pos+1);
		    $opt1 = substr($value, $opt1pos+1, $opt2pos-$opt1pos-1);
		    $value = substr($value, 0, $opt1pos);
		    $value = ($subvars->{$value} ne '')
			    ?$opt1
			    :$opt2;
		    $subvars->{$key} = $value;
		    }
		else
		    { $subvars->{$key} = "\${$value}"; }
		}
	    else
		{ $subvars->{$key} = $value; }
	    $data =~ s/\${[^{}]+}(\s*\n|)//s;
	    next;
	    }

	if (defined $val)
	    {
	    if (ref $val eq 'ARRAY')
		{ $val = 'ARRAY'; }
	    $data =~ s#\${[^{}]+}#$val#;
	    next;
	    }
	else
	    {
	    $opts->{unresolvedlist}{$1} = $opts->{file};		 # {
	    $done .= substr4($data, 0, index($data, '}'), '');
	    }
	}

    $done.$data;
    }

sub substitute_filename
    {
    my($file, $opts) = @_;
    my(%template, $root, $path, $search);

    if ($file =~ m#(/|^)\.\./#)
	{
	$opts->{fail} = "Path '$file' cannot contain '..'";
	return(undef);
	}

    # DEPRECATED
    if ($opts->{templatedir} && !$opts->{templatepath})
	{ $opts->{templatepath} = $opts->{templatedir}; }

    foreach( 'templateroot', 'templatepath', 'templatesearch' )
	{
	if (defined $opts->{$_})
	    {
	    if (ref $opts->{$_} eq 'ARRAY')
		{ $template{$_} = $opts->{$_}; }
	    else
		{ $template{$_} = [$opts->{$_}]; }
	    }
	}

    $template{templateroot} ||= [cwd . '/template'];
    $template{templatepath} ||= ['.'];
    if ($template{templatesearch})
	{
	my(@search);
	@search = @{$template{templatesearch}};
	$template{templatesearch} = \@search;
	foreach (@{$template{templatesearch}})
	    { s/\${file}/$file/g || ($_.="/$file"); }
	}
    else
	{ $template{templatesearch} = [$file]; }

    # Start DEPRECATED section
    if ($opts->{prefix} || $opts->{specific})
	{
	my(@filelist);
	$root = $template{templateroot}->[0];

	if ($file !~ m#^/# && $opts->{templatepath})
	    { $file = "$opts->{templatepath}/$file"; }

	if ($opts->{prefix})
	    {
	    if ($opts->{specific})
		{
		push(@filelist,
			    "$root/$opts->{prefix}$file.$opts->{specific}",
			    "$root/$opts->{prefix}$file",
			     "$root/$file.$opts->{specific}");
		}
	    else
		{ push(@filelist, "$root/$opts->{prefix}$file"); }
	    }
	elsif ($opts->{specific})
	    { push(@filelist, "$root/$file.$opts->{specific}"); }

	push(@filelist, "$root/$file");

	if ($opts->{templatedebug})
	    { print "<p>\n"; }
	foreach $file (@filelist)
	    {
	    if ($opts->{templatedebug})
		{ print "template: $file<br>"; }
	    if (-r $file)
		{ return $file; }
	    }
	}
	# End DEPRECATED section

    if ($opts->{templatedebug})
	{
	print "<p>root = @{$template{templateroot}}<br>\n";
	print "path = @{$template{templatepath}}<br>\n";
	print "search = @{$template{templatesearch}}<br>\n";
	}
    foreach $root (@{$template{templateroot}})
	{
	foreach $path (@{$template{templatepath}})
	    {
	    foreach $search (@{$template{templatesearch}})
		{
		my($found);
		if (substr($search, 0, 1) eq '/')
		    { $found = "$root$search"; }
		else
		    { $found = "$root/$path/$search"; }
		if ($opts->{templatedebug})
		    { print "template: $found<br>"; }
		if (-r $found)
		    { return $found; }
		}
	    }
	}

    return undef;
    }

sub template_read
    {
    my($file, $opts, $canfail) = @_;
    my($data, $filename);

    unless ($filename = substitute_filename($file, $opts))
	{
	if ($canfail)
	    { return(''); }
	$opts->{fail} ||= "Unable to read '$file': $!";
	return($opts->{fail});
	}

    if (open(SUBSTITUTE_FILE, "<$filename"))
	{
	read(SUBSTITUTE_FILE, $data, -s SUBSTITUTE_FILE);
	close(SUBSTITUTE_FILE);
	}
    else
	{
	if ($canfail)
	    { return(''); }
	$opts->{fail} = "Unable to read '$filename': $!";
	return($opts->{fail});
	}
    $data;
    }

1;
