# ==================================================================
# Gossamer Threads Module Library
#
#	GT_Template
#	Author  : Alex Krohn (alex@gossamer-threads.com)
# 
# Copyright (c) 1999 Gossamer Threads Inc.  All Rights Reserved.
# ==================================================================
#
# Description:
#	A module for parsing templates.
#
# Revision: ($REVISION $)
#

package GT_Template;
# ===============================================================
	use strict;
	use GT_Base ();
    use vars qw(@ISA $VERSION $DEBUG $ATTRIBS $ERRORS $TEMPLATE_OBJ $error);
	@ISA     = qw/GT_Base/;
    $VERSION = '1.0';
	$DEBUG   = 0;
	$ATTRIBS = { root => '.', strict => 1, compress => 0, begin => '<%', end => '%>', cache => 0 };
	$ERRORS  = {
					'NOTEMPLATE' => "No template file was specified.",
					'CANTOPEN'   => "Unable to open template file '%1%'. Reason: %2%"
    };

sub parse {
# ---------------------------------------------------------------
# Can be called as either a class method or object method.
#
	my ($self);
	if (! ref $_[0]) { 
		if ($ATTRIBS->{cache}) {
			$TEMPLATE_OBJ ||= new GT_Template; 
		}
		else {
			$self = new GT_Template;
		}
		shift;
	}
	else             { $self = shift; }

	my ($template, $vars, $opt) = @_;
	defined $template or return $self->error ('NOTEMPLATE', 'FATAL', $template);
	defined $vars     or  ($vars = {});
	defined $opt      or  ($opt  = {});

	if ($opt->{string}) {
		$self->load_string ($template, $opt->{string});
	}
	else {
		if ($template =~ m,^(.+?)/([^/]+)$,) {
			$self->root($1); $template = $2;
		}
		$self->load_file ($template);
	}
	$self->load_vars ($vars);
	return $self->_parse ($template, $opt);
}

sub load_string {
# ---------------------------------------------------------------
# Loads a string into template object.
#
	my ($self, $name, $string) = @_;
	my $root = $self->{root};
	$self->{TEMPLATES}{$root}{$name} = $string;
	$self->debug ("Loading '$name' using string: '$string'.") if ($self->{_debug});
}

sub load_file {
# ---------------------------------------------------------------
# Loads a template either from a file or from a string.
#
	my ($self, $file) = @_;
	my $root = $self->{root};

	exists $self->{TEMPLATES}{$root}{$file} and return 1;
	my $full_file = $root . "/" . $file;
	-e $full_file		       or return $self->error ('CANTOPEN', 'FATAL', $full_file, "File does not exist.");
	open (TPL, "< $full_file") or return $self->error ('CANTOPEN', 'FATAL', $full_file, $!);
	$self->{TEMPLATES}{$root}{$file} = join "", <TPL>;
	close TPL;
	$self->debug ("Loading file '$file', using root '$root'.") if ($self->{_debug});
    return 1;
}

sub load_vars {
# ---------------------------------------------------------------
# Sets the variables (all the search and replaces).
#
	my ($self, $p)  = shift->_common_param(@_);
	$self->{VARS} ||= {};
	$self->{VARS}   = { %{$self->{VARS}}, %$p };
	if ($self->{_debug}) {
		my $msg = "Setting parsing variables: \n";
		foreach (keys %$p) {
			$msg .= "\t$_ => ${$p}{$_}\n";
		}
		$self->debug ($msg);
	}
}

sub clear_vars {
# ---------------------------------------------------------------
# Clears the namespace.
#
	$_[0]->{VARS} = {};
	$_[0]->debug ("Clearing internal variables.") if ($_[0]->{_debug});
}

sub output {
# ---------------------------------------------------------------
# Return a parsed template.
#
	my ($self, $template) = @_;
	my $root = $self->{root};
	if (exists $self->{PARSED}{$root}{$template}) {
		my $temp = $self->{PARSED}{$root}{$template};
		delete $self->{PARSED}{$root}{$template};
		if ($self->{compress}) {
			&_compress (\$temp);					
		}
		return $temp;
	}
	return undef;
}

sub _parse {
# ---------------------------------------------------------------
# Parses a template.
#
	my ($self, $template, $opt) = @_;
	my $begin    = quotemeta ($self->{begin});
    my $end      = quotemeta ($self->{end});
	my $root     = $self->{root};
	my $strict   = exists $opt->{strict} ? $opt->{strict} : $self->{strict};
	my $append   = exists $opt->{append} ? $opt->{append} : $self->{append};
	my $compress = exists $opt->{compress} ? $opt->{compress} : $self->{compress};
    my $temp     = $self->{TEMPLATES}{$root}{$template};

# Parse includes, do this first so that the includes can include
# template tags.
    $temp =~ s#$begin\s*include\s*(.+?)\s*$end#
            if (exists $self->{INCLUDES}{$root}{$1}) { $self->{INCLUDES}{$root}{$1}; }
            else {
                if (open (INC, "$root/$1")) { 
                    $self->{INCLUDES}{$root}{$1} = join ("", <INC> );
                    close INC;
                    $self->{INCLUDES}{$root}{$1};
                }
                else {
                    "Can't load included file: '$root/$1' ($!)";
                }
            }
        #goe;

# Now go line by line and strip out the unwanted stuff looking for
# if and ifnot tags.
    my @lines = split /\n/, $temp;
    $temp     = ''; my @go = (1,1); my $depth = 1; my $line = '';

	LINE: foreach $line (@lines) {
# Init the previous, variable and more strings.
        my ($prev, $var, $neg, $more, $orig, $full_comp, $comp, $val) = ('', '', '', '', '', '', '', '');
		my $result = 0;

# Check for if tags. 
        $line =~ s/((.*?)$begin\s*if(not)?\s+(.+?)(\s+(<|>|lt|gt|eq|=)\s*(.+?))?$end(.*))/
                    ($orig, $prev, $neg, $var, $full_comp, $comp, $val, $more) = ($1, $2, $3, $4, $5, $6, $7, $8);

# We've found an if tag, let's set the depth to see whether we are in print mode or not.
                    if ($prev !~ m,$begin\s*endif\s*$end,og) {
                        $go[$depth] and ($temp .= $prev);
						if (!$full_comp) {
	                        if ($neg) { ($self->{VARS}{$var}) ? ($go[++$depth] = 0) : ($go[++$depth] = $go[$depth]) and ""; }
					        else {      ($self->{VARS}{$var}) ? ($go[++$depth] = $go[$depth]) : ($go[++$depth] = 0) and ""; }
						}
						else {
							$val =~ s,^['"],,; $val =~ s,['"]$,,;
							($comp eq 'eq') and ($result = ($self->{VARS}{$var} eq $val));
							($comp eq '==') and ($result = ($self->{VARS}{$var} == $val));
							($comp eq 'lt') and ($result = ($self->{VARS}{$var} lt $val));
							($comp eq 'gt') and ($result = ($self->{VARS}{$var} gt $val));
							($comp eq '>')  and ($result = ($self->{VARS}{$var} > $val));
							($comp eq '<')  and ($result = ($self->{VARS}{$var} < $val));
							if ($neg) { $result ? ($go[++$depth] = 0) : ($go[++$depth] = $go[$depth]) and ""; }
							else      { $result ? ($go[++$depth] = $go[$depth]) : ($go[++$depth] = 0) and ""; }
						}
					}
                    else {
# Oops, there was an endif tag we missed, set the original line back and keep going.
                        $more = '';    $orig;
                    }
                /oe;
        if ($more) { $line = $more; redo LINE; }

# Check for endif tags.
        $line =~ s/(.*?)$begin\s*endif\s*$end(.*)/
                    ($prev, $more) = ($1, $2);
                    $go[$depth] and ($temp .= $prev);
                    $go[$depth--] = 1;
					"";
                /oe;
        if ($more) { $line = $more; redo LINE; }

# Add the content..
        $go[$depth] and ($temp .= "$line\n");
    }

# Replace the special variables, we allow code ref mapping.
    $temp =~ s/$begin\s*(.+?)\s*$end/
            if (exists $self->{VARS}{$1}) {
                ref ($self->{VARS}{$1}) eq 'CODE' ? 
                    &{$self->{VARS}{$1}}($self->{VARS}) : $self->{VARS}{$1};
            }
            else { $strict ? "Unknown Tag: $1" : ''; }
        /goe;
	if ($compress && !$append) {
		$self->debug ("Compressing output for template '$template'.") if ($self->{_debug});
		&_compress (\$temp);		
	}
	if ($append) {
		$self->{PARSED}{$root}{$template} .= $temp;
	}
	return $temp;
}

sub _compress {
# --------------------------------------------------------
# Compress html by removing extra space (idea/some re from HTML::Clean).
#
	my $text = shift;
	$$text =~ s,[\r\n]+,\n,sg; 
	$$text =~ s,\s+\n,\n,sg; 
	$$text =~ s,\n\s+<,\n<,sg;
	$$text =~ s,\n\s+,\n ,sg; 
	$$text =~ s,>\n\s*<,><,sg;
	$$text =~ s,\s+>,>,sg;
	$$text =~ s,<\s+,<,sg;
}

1;

__DATA__

Usage:
	- as class method:
		print GT_Template->parse ('filename', { a => b }, { options });
	- as object:
		my $tpl = new GT_Template;
		$tpl->parse ('filename', { a => b }, { options });
		for (1 .. 10) {
			$tpl->parse ('row.htm', { number => $_ } , { append => 1 });
		}
		$tpl->compress(1);
		print $tpl->output('row.htm');
		
		note: a = variable name.
		      b = actual value.

Options:
	strict - Can be set to either 1 or 0 and determines whether an error
			will be displayed if an unknown tag is used.
	compress - Set to either 1 or 0, and will compress (strip whitespace) html 
			output.
	append - Set to either 1 or 0, and will append to previous parsing.
	string - pass in a string to use as a template, rather then a file.

Todo: 
	- Add ignore case functionality.

Control Structures:
	- IF statement is available in GT_Templates.  Comparison operators include:
	    'eq'  - equal to (string)
		'=='  - equal to 
		'lt'  - less than (string)
		'gt'  - greater than (string)
		'>'   - greater than
		'<'   - less than
		'not' - not

	- statements begin with
			<%if variable_name%>	
				eg. <%if start_flag%>

			__or__

    		<%if variable_name operator value%>
				eg. <%if name eq john%>

			__or__
	
			<%ifnot condition%>
				eg. <%ifnot start%>
				eg. <%ifnot age < 10%>
	  
	  and all IF statements end with <%endif%>.


	  eg.  <%if name eq john%>
				
				.... html code ....

			<%endif%>

			html code between the tags are printed if name equals 'john'.