# Var_Sub.pm -v 1.2
#
# usage:  $new_string=Var_Sub($old_string, \%Symbol Table...)
# 
# each occurance of a Symbol in $old_string is replaced with the corresponding
# value from the passed Symbol Tables.
#
# Author: Scott Wimer <scottw@cgibuilder.com>
# Date: 1998 02 07
#
######################################################################


### Make Var_Sub a module
package        Var_Sub;
require        5.000;           # Minimal Requirements for their Perl
require        Exporter;
@ISA        =  qw(Exporter);
@EXPORT     =  qw(Var_Sub);
@EXPORT_OK  =  qw($SYMBOL_RE);
###

use strict;


### define Global variables
use vars '$SYMBOL_RE';
$SYMBOL_RE='(\$)                    # $1  Beginning dollar sign
             ({?)                   # $2  Optional opening brace
              ([a-zA-Z_]\w*)        # $3  Text of the Symbol
             (}?)                   # $4  Optional closing brace
             (  \(                  # $5  Beginning Paren for Function Args
#                   (.*|\\)*|\n*)    # $6  Function Args
                   (.*?|\n*)    # $6  Function Args
             \)  )?'                # $7  Closing Paran for Function Args
            ;                       # $8  End of Symbol Definition
###



sub Var_Sub($$@) {
#print STDERR "\t- Entering Var_Sub -\n";

my $template=shift; # grab the first argument, the rest are Symbol Tables

### variable declarations 
my @parts;               # the array to hold the parts of the new string
my $not_found=0;         # flag if a Symbol in the string is not found
my $last_match_pos;      # position of the last match in the string
my $escaped=0;           # was the current Symbol backslash escaped?  1=TRUE
my $func_flag=0;         # indicate that the current Symbol is a function
my $ST;                  # the current Symbol Table
my $symbol;
my $args;
my (@Symbol_Tables);
my $function_input;
my $function_output;
###

### walk down the template/string and replace each Symbol with it's value
##- note that these $<number> values are off by two when compared with the
##- comments above.  That's because of the first two parts of the regex
##- below.
#print STDERR "--- Entering Var_Sub ---\n";
#print STDERR "\tTemplate=$template\n";
while ( $template=~m/(.*?)(\\*)$SYMBOL_RE/xogs )
{

# print "\$3=$3*\n";
# print "\$4=$4*\n";
# print "\$5=$5*\n";
# print "\$6=$6*\n";
# print "\$7=$7*\n";
# print "\$8=$8*\n";
# print "\$9=$9*\n";
# print "\$10=$10\n";


 $args=$8;
 my $match_string="$2$3$4$5$6$7";
 my $no_slash_match_string="$3$4$5$6$7";
# print STDERR "\tMatch_string=$match_string\n";
 $func_flag=0; # reset this flag
 push (@parts, $1); # store the text preceding the Symbol

 if ($2) # if there was a backslash preceding the Symbol
 {
  my $slashes=$2;
  $escaped=1;
  substr($slashes,0,1)=undef;  # remove the first backslash
  push @parts, $slashes; # save the slashes (Minus 1)
 }
 
 ### replace the Symbol (if it's found in a Symbol Table) or push it onto the
 ##- output string.
 if (! $escaped) # if this Symbol was NOT escaped
 {
  $symbol="$3$5";
  $func_flag=1 if $7;  # is this a function or not
  $symbol.='()' if $func_flag; # put parens on before lookup if it's a function
#  print STDERR "\tSymbol=$symbol\n";
  
  ### loop through the Symbol Tables that were passed, find first matching
  ##- Symbol definition
  foreach $ST (@_)
  {
   $not_found=$symbol;  # haven't found this Symbol yet
   if ( exists($ST->{$symbol}) )
   { 
    if ($func_flag) # we're looking for a function
    {
     @Symbol_Tables=@_; # so the recursive call to Var_Sub has some STs
#     print STDERR "\tfunc args=$args\n";
     $function_input=Var_Sub($args, @Symbol_Tables);
#     print STDERR "function input=$function_input*\n";
     $function_output=&{ $ST->{$symbol}->{Code} }($function_input);
#     print STDERR "\tfunc_out=$function_output*\n";
     push (@parts, $function_output);
     $not_found=0;
     last;  # we've found this Symbol, stop looking
    }
    else  # regular joe Symbol, just push value from ST onto output string
    {
     push (@parts, $ST->{$symbol});
     $not_found=0;
     last; # we've found this Symbol, stop looking
    }
   }
   ### 
  } # --- end of foreach $ST (@_) loop through tables
 } 
 else  # this Symbol WAS escaped, save the whole thing an push it onto output
 {
  push (@parts, $no_slash_match_string);
 }
 ###

 ### Pass undefined Symbols through
 if ($not_found)
 {
#  print STDERR "Warning: '$symbol' not found.\n";
  push (@parts, $match_string);
 }
 ###

 $func_flag=0;                    # reset function flag
 $escaped=0;                      # reset escaped flag
 $last_match_pos=pos($template);  # record the last matching position
}
###

### now dump the remainder of the template string
push @parts, substr($template, $last_match_pos,
              (length ($template) - $last_match_pos) );
###
 

#print STDERR "--- Leaving Var_Sub ---\n";

### return to the caller
return ( join("", @parts)  );
### 

}
1;