#!/usr/local/bin/perl -w
#
# Macros.pm
#
# A simple text macro processing utility.
#
# See Macros.html for the language specification.
#
# Copyright (c) 1999, Drew Folta (drew@io.com)
#


package			Macros;
require			5.004;
require			Exporter;
$Macros::VERSION =		1.000;
@ISA =			qw( Exporter );
@EXPORT	=		qw( ProcessMacros );

%EXPORT_TAGS =	( DEBUG => [qw(ProcessMacros TRACE_LEVEL
							USE_TILDE USE_ASSIGN 
							USE_IF USE_REPEAT)] );
Exporter::export_ok_tags('DEBUG');


#
# Coding Conventions/Assumptions
#
#	- The indices, as returned by index(), point to before the 
#	  character.  When I keep stats on a tag, though, the 
#	  beginning index points to before the first character, but 
#	  the ending index points to -after- the last character.
#
#	- Tilde-macro substitution in brace-macros works.  This makes
#	  the logic somewhat hairy.
#
#	- If you're debugging, you can set TRACE_LEVEL.  Use 1 to
#	  just spit out the processing steps.  Use 2 to see a
#	  snapshot of the text after each step.  Use 3 (from the 
#	  command line) to step through and see which macros are
#	  being scanned for.
#
#	- Logic structure could probably have been done cleaner. :)
#


use strict;


# debug stuff
$Macros::TRACE_LEVEL = 0;	# 0 none, 1 steps, 2 snapshots, 3 scans
$Macros::USE_TILDE = 1;
$Macros::USE_ASSIGN = 1;
$Macros::USE_SPLIT = 1;
$Macros::USE_IF = 1;
$Macros::USE_REPEAT = 1;


# function prototypes
sub ProcessMacros (\%\$;$);
sub GetBraceMacro (\$$);
sub GetTildeMacro (\$$);
sub ScanForCloseTag (\$$;$);



sub
ProcessMacros (\%\$;$)
	{
	my ( $macros, $text, $startOffset ) = @_;	# name arguments
	$startOffset = 0 if not defined $startOffset;
	
	# forward declarations
	
	# ot is for Open Tag (<if> or <repeat>)
	# ct is for Close Tag (</if> or </repeat>)
	my ( $otBegin, $otEnd, $otLength );
	my ( $ctBegin, $ctEnd, $ctLength );
	
	my ( $name, $value );
	
	my ( $tildeBegin, $tildeEnd, $tildeLength );
	my ( $braceBegin, $braceEnd, $braceLength );
	my $first;
	
	MACRO : 
	while ( $startOffset < length ${$text} )
		{
		print "snapshot :: " if $Macros::TRACE_LEVEL >= 3;
		scalar <STDIN> if $Macros::TRACE_LEVEL >= 3;
		print "<hr>\n" if $Macros::TRACE_LEVEL >= 2;
		print ${$text} if $Macros::TRACE_LEVEL >= 2;
		print "<hr>\n" if $Macros::TRACE_LEVEL >= 2;
		
		# get next macro
		($tildeBegin,$tildeEnd,$tildeLength) = GetTildeMacro(${$text},$startOffset);
		($braceBegin,$braceEnd,$braceLength) = GetBraceMacro(${$text},$startOffset);
		
		last MACRO if ( $tildeBegin == -1 and $braceBegin == -1 );
		if ( $tildeBegin == -1 )		{ $first = $braceBegin }
		elsif ( $braceBegin == -1 )		{ $first = $tildeBegin }
		else	{ $first = $braceEnd <= $tildeBegin ? $braceBegin : $tildeBegin; }
		
		
		# tilde-macro substitution
		if ( $Macros::USE_TILDE and $first == $tildeBegin )
			{
			# get macro name
			$name = substr ( ${$text}, $tildeBegin+1, $tildeLength-2 );
			
			# tilde-tilde substitution
			if ( not length $name )
				{
				substr ( ${$text}, $tildeBegin, $tildeLength ) = '~';
				$startOffset = $tildeBegin + 1;
				next MACRO;
				}
			
			# skip undefined macros
			if ( not exists $macros->{$name} )
				{
				print "skipping undefined ~$name~\n" if $Macros::TRACE_LEVEL >= 1;
				
				$startOffset = $tildeEnd;
				next MACRO;
				}
			
			print "substituting $macros->{$name} for ~$name~\n" if $Macros::TRACE_LEVEL >= 1;
			
			# replace macro
			substr ( ${$text}, $tildeBegin, $tildeLength ) = $macros->{$name};
			
			# go around again
#			$startOffset = $tildeBegin + length $macros->{$name};
			next MACRO;
			}
		
		
		# brace-macro substitution
		
		# $control is first word, $remander is rest
		my $tagParts = substr(${$text},$braceBegin+1,$braceLength-2);
		my ( $control, $remander ) = split /\s+/, $tagParts, 2;
		
		# set macro value
		if ( $Macros::USE_ASSIGN and lc($control) eq "set" )
			{
			# calculate value
			( $name, $value ) = split '=', $remander, 2;
			$value =~ s/^\"(.*)\"$/$1/s;		# strip surrounding quotes
			
			# make assignment
			$macros->{$name} = $value;
			print "macro $name set to $value\n" if $Macros::TRACE_LEVEL >= 1;
			
			# ditch tag
			substr ( ${$text}, $braceBegin, $braceLength ) = "";
			
			# go around again
			$startOffset = $braceBegin;
			next MACRO;
			}
		
		
		# 'split' construct
		if ( $Macros::USE_SPLIT and lc($control) eq "split" )
			{
			my $origin;
			($origin,$remander) = split /\s+/, $remander, 2;
			
			my $delimiter;
			($delimiter,$remander) = BreakOutDelimiter($remander);
			
			$remander =~ s/^\s+//;
			my @destinations = split /\s+/, $remander;
			
			# set destination values
			my @values = SplitValues ( $macros->{$origin},$delimiter );
			
			if ( @values > @destinations )
				{
				$values[$#destinations] = join(" ", splice(@values,$#destinations));
				$#values = $#destinations;		# truncate values
				}
			
			# modify assigned-to destination variables
			foreach ( @values )
				{
				$macros->{shift(@destinations)} = $_;
				@destinations or last;		# assert more
				}
			
			# undefine excess destination variables
			foreach ( @destinations )
				{
				$macros->{$_} = undef
				}
			
			# ditch tag
			substr ( ${$text}, $braceBegin, $braceLength ) = "";
			
			# go around again
			$startOffset = $braceBegin;
			next MACRO;
			}
		
		
		# 'if' construct
		if ( $Macros::USE_IF and lc($control) eq "if" )
			{
			# get open tag stats
			$otBegin = $braceBegin;
			$otEnd = $braceEnd;
			$otLength = $braceLength;
			
			# scan ahead for matching close tag and else
			my ( $elseBegin, $elseEnd );
			( $ctBegin, $ctEnd, $elseBegin, $elseEnd ) 
				= ScanForCloseTag(${$text},$otEnd);
			
			# missing close tag
			if ( $ctBegin == -1 )
				{
				$startOffset = $otEnd;		# skip this tag
				next MACRO;
				}
			
			# calculate test results
			my ( $firstWord, $restOfWords );
			( $firstWord, $restOfWords ) = split /\s+/, $remander, 2;
			my $pass = 0;
			if ( lc($firstWord) eq "defined" )
				{
				$name = $restOfWords;
				$pass = 1 if ( exists $macros->{$name} );
				
				print "test of $name defined " if $Macros::TRACE_LEVEL >= 1;
				print ($pass ? "passed\n" : "failed\n") if $Macros::TRACE_LEVEL >= 1;
				}
			else
				{
				$value = undef;
				($name,$value) = split '=', $remander, 2;
				$value =~ s/^\"(.*)\"$/$1/ if defined $value;		# strip surrounding quotes
				
				if ( exists $macros->{$name} )
					{
					if ( not defined $value )
						{ 
						$pass = 1 if $macros->{$name}; 
						}
					elsif ( $macros->{$name} eq $value )
						{ $pass = 1; }
					}
				
				print "test of $name equals $value " if $Macros::TRACE_LEVEL >= 1;
				print ($pass ? "passed" : "failed") if $Macros::TRACE_LEVEL >= 1;
				print ". ($name actually equals $macros->{$name})\n" if $Macros::TRACE_LEVEL >= 1;
				}
			
			# adjust for missing else-macro
			if ( not defined $elseBegin )
				{
				$elseBegin = $ctBegin;
				$elseEnd = $ctBegin;
				}
			
			# figure out what to save
			my ( $saveBegin, $saveEnd );
			if ( $pass )
				{
				$saveBegin = $otEnd;
				$saveEnd = $elseBegin;
				}
			else
				{
				$saveBegin = $elseEnd;
				$saveEnd = $ctBegin;
				}
			
			# replace
			substr ( ${$text}, $otBegin, $ctEnd-$otBegin ) = 
				substr ( ${$text}, $saveBegin, $saveEnd-$saveBegin );
			
			# go around again
			$startOffset = $braceBegin;
			next MACRO;
			}
		
		
		# 'repeat' construct
		if ( $Macros::USE_REPEAT and lc($control) eq "repeat" )
			{
			# get open tag stats
			$otBegin = $braceBegin;
			$otEnd = $braceEnd;
			$otLength = $braceLength;
			
			# calculate macro name
			($name, $remander) = split /\s+/, $remander, 2;
			
			print "starting repeat $name\n" if $Macros::TRACE_LEVEL >= 1;
			
			# scan ahead for matching close tag and tilde-macros
			my @tildeStack;
			( $ctBegin, $ctEnd, @tildeStack ) 
				= ScanForCloseTag(${$text},$otEnd,$name);
			
			# missing close tag
			if ( $ctBegin == -1 )
				{
				print "missing close tag\n" if $Macros::TRACE_LEVEL >= 1;
				$startOffset = $otEnd;		# skip this tag
				next MACRO;
				}
			
			# get close tag stats
				# already gotten
			

			# skip undefined variables
			if ( not exists $macros->{$name} )
				{
				print "removing undefined repeat ~$name~\n" if $Macros::TRACE_LEVEL >= 1;
				
				substr ( ${$text}, $otBegin, $ctEnd-$otBegin ) = "";
				$startOffset = $otBegin;
				next MACRO;
				}
			
			# calculate macro value list
			my ($delimiter) = BreakOutDelimiter($remander);
			undef $delimiter unless length $remander;
			my @values = SplitValues ( $macros->{$name}, $delimiter );
			
			# create replacement text
			my $replace = "";
			if ( scalar(@tildeStack) )		# we have inner tilde-macros
				{
				# save pre and post parts
				my ( $prePart, @postParts );
				my $tildeBegin = shift @tildeStack;
				my $tildeEnd = shift @tildeStack;
				$prePart = substr ( ${$text}, $otEnd, $tildeBegin-$otEnd );
				while ( scalar @tildeStack )
					{
					# get next tilde
					my $nextTildeBegin = shift @tildeStack;
					my $nextTildeEnd = shift @tildeStack;
					
					# get section from this to next tilde
					push @postParts, substr ( ${$text}, $tildeEnd, $nextTildeBegin-$tildeEnd );
					
					# step forward
					$tildeEnd = $nextTildeEnd;
					}
				
				# get last post part
				push @postParts, substr ( ${$text}, $tildeEnd, $ctBegin-$tildeEnd );
				
				# create replacement text
				my $ppCounter = 0;		# post part counter
				for ( 0 .. $#values )
					{
					$replace .= $prePart . $values[$_] . $postParts[$ppCounter];
					$ppCounter++;
					$ppCounter = 0 if $ppCounter > $#postParts;
					}
				}
			
			else		# no innner tilde-macros
				{
				$replace = substr ( ${$text}, $otEnd, $ctBegin-$otEnd );
				$replace = $replace x scalar(@values);
				}
			
			# replace
			print("replacing ",scalar(@values)," instances\n") if $Macros::TRACE_LEVEL >= 1;
			substr ( ${$text}, $otBegin, $ctEnd-$otBegin ) = $replace;
			
			# go around again
			print "done repeat\n" if $Macros::TRACE_LEVEL >= 1;
			$startOffset = $braceBegin;
			next MACRO;
			}
		
		
		# unknown control, most likely some kind of html tag
		print "skipping unknown brace-macro $control\n" if $Macros::TRACE_LEVEL >= 1;
		$startOffset = $braceEnd;	# skip unknown brace
		next MACRO;
		}
	
	
	print "--------- done processing --------\n" if $Macros::TRACE_LEVEL >= 1;
	return 1;
	}



sub
BreakOutDelimiter ($)
	
	# Takes a string starting with 'delimiter=' and
	# breaks out the delimiter.  The trick is that the
	# delimiter may include spaces if it is included
	# in double-quotes.
	
	# Returns two values: the delimiter and any remaining
	# text.  Returns undef if something goes wrong.
	
	{
	my $text = shift || return undef;
	
	# strip 'delimiter='
	$text =~ s/^delimiter=//i or return undef;
	
	if ( substr($text,0,1) eq '"' )
		{
		my $index = index($text,'"',1);
		my $delimiter = substr($text,1,$index-1);
		return $delimiter, substr($text,$index+1);
		}
	else
		{
		return split /\s+/, $text, 2;
		}
	}



sub
GetBraceMacro (\$$)
	# reference to text
	# start offset
	
	# Trouble is we may run into braces inside the macro.
	# (For example <repeat delimiter="<br>"> .)  We solve
	# this by looking for matching double-quotes and
	# skipping if they are missing.
	
	{
	my ( $text, $startOffset ) = @_;	# name arguments
	my ( $open, $close );
	
	$open = index ( ${$text}, '<', $startOffset );
	return -1 if $open == -1;		# missing open bracket
	
	my $quoteCount = 0;
	my $scanStart = $open + 1;
	my $potentialTag;
	while ( 1 )
		{
		# get close bracket
		$close = index ( ${$text}, '>', $scanStart );
		return -1 if $close == -1;		# missing close bracket
		
		# count quotes between opening and closing tags
		$quoteCount = 0;
		$potentialTag = substr ( ${$text}, $open, $close-$open );
		$quoteCount++ while $potentialTag =~ m/"/g;
		
		# last if even number of quotes
		last if $quoteCount % 2 == 0;
		
		$scanStart = $close + 1;
		}
	
#	print "found $quoteCount quotes\n" if $Macros::TRACE_LEVEL >= 3;
	print "found brace-macro ", substr ( ${$text}, $open, $close+1-$open), " at $open - $close :: " if $Macros::TRACE_LEVEL >= 3;
	scalar <STDIN> if $Macros::TRACE_LEVEL >= 3;
	
	$close++;
	return $open, $close, $close - $open;
	}



sub
GetTildeMacro (\$$)
	# reference to text
	# start offset
	
	{
	my ( $text, $startOffset ) = @_;	# name arguments
	my ( $first, $second );
	
	$first = index ( ${$text}, '~', $startOffset );
	return -1 if $first == -1;
	
	$second = index ( ${$text}, '~', $first+1 ) + 1;
	return -1 if $second == 0;
	
	print "found tilde-macro ", substr ( ${$text}, $first, $second-$first), " at $first - $second :: " if $Macros::TRACE_LEVEL >= 3;
	scalar <STDIN> if $Macros::TRACE_LEVEL >= 3;
	
	return $first, $second, $second - $first;
	}



sub
ScanForCloseTag (\$$;$)
	
	# Takes a reference to the text and an offset to start in the text.
	# If an optional tag name is also given, this function will look for
	# a 'repeat' end tag and inner tilde-macros with the given name.
	#
	# Returns the beginning and end of the close tag, as well as a
	# list of the beginning and end indices of the inner tags (tilde-macros
	# for 'repeat' structures and else-macros for 'if' structures).
	#
	# If no matching close tag is found, returns (-1,-1).
	
	{
	my ( $text, $scanStart, $repeatName ) = @_;		# name arguments
	my $tag = defined $repeatName ? 'repeat' : 'if';
	
	print "scanning for close $tag\n" if $Macros::TRACE_LEVEL >= 3;
	
	my ( $tildeBegin, $tildeEnd, $tildeLength );
	my ( $braceBegin, $braceEnd, $braceLength );
	my ( $ctBegin, $ctEnd, @innerTagStack );
	my ( $itBegin, $itEnd, $itLength, $itName );	# 'it' is Inner Tag
	
	my $scanLevel = 0;
	SCAN: 
	while ( $scanStart < length ${$text} )
		{
		# get next tilde and brace
		($tildeBegin,$tildeEnd,$tildeLength) = GetTildeMacro(${$text},$scanStart);
		($braceBegin,$braceEnd,$braceLength) = GetBraceMacro(${$text},$scanStart);
		last SCAN if $braceBegin == -1;
		
		# if we are searching for tilde's and we have one, we
		# need to save the tilde info onto the stack
		if ( $tag eq 'repeat' and $tildeBegin != -1 and $tildeBegin < $braceEnd )
			{
			# find matching tilde and tilde-macro name
			$itBegin = $tildeBegin;
			$itEnd = $tildeEnd;
			$itLength = $tildeLength;
			my $itName = substr ( ${$text}, $itBegin+1, $itLength-2 );
			
			if ( $itName eq $repeatName )
				{ 
				push @innerTagStack, $itBegin, $itEnd; 
				print "found a ~$itName~\n" if $Macros::TRACE_LEVEL >= 2;
				}
			
			$scanStart = $tildeEnd;
			next SCAN;
			}
		
		# get brace-tag stats
		$itBegin = $braceBegin;
		$itEnd = $braceEnd;
		$itLength = $braceLength;
		my ($itName) = split /\s+/, substr(${$text},$itBegin+1,$itLength-2);
		
		# adjust scan level
		if ( lc($itName) eq $tag )
			{ $scanLevel++; }
		elsif ( lc($itName) eq "/$tag" )
			{ $scanLevel--; }
		
		# push else-macro if we are looking for them
		if (	$scanLevel == 0 and 
				$tag eq 'if' and 
				lc($itName) eq 'else' )
			{ 
			push @innerTagStack, $itBegin, $itEnd; 
			print "found an <else>\n" if $Macros::TRACE_LEVEL >= 3;
			}
		
		# found tag
		if ( $scanLevel < 0 )
			{
			$ctBegin = $itBegin;
			$ctEnd = $itEnd;
			last SCAN;
			}
		
		$scanStart = $itEnd;
		next SCAN;
		} # SCAN
	continue
		{
		print "next scan at $scanStart\n" if $Macros::TRACE_LEVEL >= 3;
		}
	
	print "done scanning\n" if $Macros::TRACE_LEVEL >= 3;
	return $ctBegin, $ctEnd, @innerTagStack;
	}



sub
SplitValues ($;$)
	# Splits a source using a delimiter.  If the source is a
	# reference to an array, than each element of the array
	# is split, and the resulting lists are concatenated.
	
	{
	my $source = shift;
	my $delimiter = shift;
	
	my @values;
	if ( ref($source) eq "ARRAY" )
		{
		# split each line of an array
		if ( defined $delimiter )
			{
			foreach ( @$source )
				{ push @values, split($delimiter,$_); }
			}
		else
			{ push @values, @$source; }
		}
	else
		{
		if ( defined $delimiter )
			{ @values = split $delimiter, $source; }
		else
			{ push @values, $source; }
		}
	return @values;
	}



1;	# successful file