package HTML::Template;
use HTML::Template::Config;

use strict; # and no funny business, either.

use Carp; # generate better errors with more context
use Digest::MD5 qw(md5_hex); # generate package name
use File::Spec; # generate paths that work on all platforms
use Devel::Timer;
use Number::Format;

our $BLANK;

# open a new template and return an object handle
sub new {
	my $pkg = shift;
	my $self; { my %hash; $self = bless(\%hash, $pkg); }

	# the options hash
	my $options = {};
	$self->{options} = $options;

	foreach (keys %HTML::Template::Config::default_options) {
		$options->{$_} = $HTML::Template::Config::default_options{$_};
	}

	# load in options supplied to new()
	for (my $x = 0; $x <= $#_; $x += 2) {
		defined($_[($x + 1)]) or croak("HTML::Template->new() called with odd number of option parameters - should be of the form option => value");
		$options->{lc($_[$x])} = $_[($x + 1)]; 
	}

	$options->{file_cache_dir_ownerid} = getpwnam($options->{file_cache_dir_owner});
	croak("HTML::Template->new() called with invalid file_cache_dir_owner") unless (defined $options->{file_cache_dir_ownerid});

	$options->{file_cache_dir_groupid} = getgrnam($options->{file_cache_dir_group});
	croak("HTML::Template->new() called with invalid file_cache_dir_group") unless (defined $options->{file_cache_dir_groupid});

	$options->{file_cache_file_ownerid} = getpwnam($options->{file_cache_file_owner});
	croak("HTML::Template->new() called with invalid file_cache_file_owner") unless (defined $options->{file_cache_file_ownerid});

	$options->{file_cache_file_groupid} = getgrnam($options->{file_cache_file_group});
	croak("HTML::Template->new() called with invalid file_cache_file_group") unless (defined $options->{file_cache_file_groupid});

	# handle the "type", "source" parameter format (does anyone use it?)
	if (exists($options->{type})) {
		exists($options->{source}) or croak("HTML::Template->new() called with 'type' parameter set, but no 'source'!");
		($options->{type} eq 'filename' or $options->{type} eq 'scalarref' or
		$options->{type} eq 'arrayref' or $options->{type} eq 'filehandle') or
		croak("HTML::Template->new() : type parameter must be set to 'filename', 'arrayref', 'scalarref' or 'filehandle'!");

		$options->{$options->{type}} = $options->{source};
		delete $options->{type};
		delete $options->{source};
	}

	# path should be an array if it's not already
	if (ref($options->{path}) ne 'ARRAY') {
		$options->{path} = [ $options->{path} ];
	}

	if ($options->{filename} =~ /(^\/.*\/)([^\/]+)$/) {
		unshift @{$options->{path}}, $1;

		$options->{filename} = $2;
	}

	# filter should be an array if it's not already
	if (ref($options->{filter}) ne 'ARRAY') {
		$options->{filter} = [ $options->{filter} ];
	}

	# check for syntax errors:
	my $source_count = 0;
	exists($options->{filename}) and $source_count++;
	exists($options->{filehandle}) and $source_count++;
	exists($options->{arrayref}) and $source_count++;
	exists($options->{scalarref}) and $source_count++;
	if ($source_count != 1) {
		croak("HTML::Template->new called with multiple (or no) template sources specified!  A valid call to new() has exactly one filename => 'file' OR exactly one scalarref => \\\$scalar OR exactly one arrayref => \\\@array OR exactly one filehandle => \*FH");
	}

	# initialize data structures
	$self->_init;

	return $self;
}

# utility function - given a filename performs documented search and
# returns a full path of undef if the file cannot be found.
sub _find_file {
	my ($self, $filename, $extra_path) = @_;
	my $options = $self->{options};
	my $filepath;

	# first check for a full path
	return File::Spec->canonpath($filename) if (File::Spec->file_name_is_absolute($filename) and (-e $filename));

	# try the extra_path if one was specified
	if (defined($extra_path)) {
		$extra_path->[$#{$extra_path}] = $filename;
		$filepath = File::Spec->canonpath(File::Spec->catfile(@$extra_path));
		return File::Spec->canonpath($filepath) if -e $filepath;
	}

	# try pre-prending HTML_Template_Root
	if (exists($ENV{HTML_TEMPLATE_ROOT})) {
		$filepath =  File::Spec->catfile($ENV{HTML_TEMPLATE_ROOT}, $filename);
		return File::Spec->canonpath($filepath) if -e $filepath;
	}

	# try "path" option list..
	foreach my $path (@{$options->{path}}) {
		$filepath = File::Spec->canonpath(File::Spec->catfile($path, $filename));
		return File::Spec->canonpath($filepath) if -e $filepath;
	}

	# try even a relative path from the current directory...
	return File::Spec->canonpath($filename) if -e $filename;

	return undef;
}

# utility function - computes the mtime for $filename
sub _mtime {
	my ($self, $filepath) = @_;
	my $options = $self->{options};

	# make sure it still exists in the filesystem 
	(-r $filepath) or Carp::confess("HTML::Template : template file $filepath does not exist or is unreadable.");

	# get the modification time
	return (stat(_))[9];
}

# initialize the template buffer
sub _init {
	my $self = shift;
	my $options = $self->{options};

	if (exists($options->{filename})) {    
		my $filepath = $options->{filepath};
		if (not defined $filepath) {
			$filepath = $self->_find_file($options->{filename});
			confess("HTML::Template->new() : Cannot open included file $options->{filename} : file not found.") unless defined($filepath);
			# we'll need this for future reference - to call stat() for example.
			$options->{filepath} = $filepath;   
		}

		$self->{md5_packagename} = md5_hex($options->{filepath});
		if (defined eval('return $ht' . $self->{md5_packagename} . '::mtime;')) {
			return if ($options->{blind_cache});
		} else {
			if ($options->{file_cache} && (defined $options->{file_cache_dir})) {
				eval 'use lib \'' . $options->{file_cache_dir} . '\'; require ht' . $self->{md5_packagename} . ';';

				if (defined eval('return $ht' . $self->{md5_packagename} . '::mtime;')) {
					my $dependencies;
					eval('$dependencies = \@ht' . $self->{md5_packagename} . '::includes;');

					if (ref($dependencies) eq 'ARRAY') {
						foreach my $name (@{$dependencies}) {
							my @options;
							push @options, 'filename';
							push @options, $name;
							foreach (grep(!/^file(name|path)/, keys %{$options})) {
								push @options, $_;
								push @options, $options->{$_};
							}
							my $template = HTML::Template->new(@options);
						}
					}

					return if ($options->{blind_cache});
				}
			}
		}

		$self->{mtime} = $self->_mtime($filepath);

		return if ((eval('return $ht' . $self->{md5_packagename} . '::mtime;') || '') eq $self->{mtime});

		confess("HTML::Template->new() : Cannot open included file $options->{filename} : $!") unless defined(open(TEMPLATE, $filepath));

		# read into scalar, note the mtime for the record
		$self->{template} = "";
		while (read(TEMPLATE, $self->{template}, 10240, length($self->{template}))) {}
		close(TEMPLATE);
	} elsif (exists($options->{scalarref})) {
		# copy in the template text
		$self->{template} = ${$options->{scalarref}};

		delete($options->{scalarref});
	} elsif (exists($options->{arrayref})) {
		# if we have an array ref, join and store the template text
		$self->{template} = join("", @{$options->{arrayref}});

		delete($options->{arrayref});
	} elsif (exists($options->{filehandle})) {
		# just read everything in in one go
		local $/ = undef;
		$self->{template} = readline($options->{filehandle});

		delete($options->{filehandle});
	} else {
		confess("HTML::Template : Need to call new with filename, filehandle, scalarref or arrayref parameter specified.");
	}

	unless (exists($options->{filename})) {
		$self->{md5_packagename} = md5_hex($self->{template});
		return if (defined eval('return $ht' . $self->{md5_packagename} . '::mtime;'));
	}

	# handle filters if necessary
	$self->_call_filters(\$self->{template}) if @{$options->{filter}};

	# if we're here, then we didn't get a cached copy, so do a full
	# init.
	$self->_parse();

	return $self;
}

# handle calling user defined filters
sub _call_filters {
	my $self = shift;
	my $template_ref = shift;
	my $options = $self->{options};

	my ($format, $sub);
	foreach my $filter (@{$options->{filter}}) {
		croak("HTML::Template->new() : bad value set for filter parameter - must be a code ref or a hash ref.") unless ref $filter;

		# translate into CODE->HASH
		$filter = { 'format' => 'scalar', 'sub' => $filter } if (ref $filter eq 'CODE');

		if (ref $filter eq 'HASH') {
			$format = $filter->{'format'};
			$sub = $filter->{'sub'};

			# check types and values
			croak("HTML::Template->new() : bad value set for filter parameter - hash must contain \"format\" key and \"sub\" key.")
			unless defined $format and defined $sub;
			croak("HTML::Template->new() : bad value set for filter parameter - \"format\" must be either 'array' or 'scalar'")
			unless $format eq 'array' or $format eq 'scalar';
			croak("HTML::Template->new() : bad value set for filter parameter - \"sub\" must be a code ref")
			unless ref $sub and ref $sub eq 'CODE';

			# catch errors
			eval {
				if ($format eq 'scalar') {
					  # call
					  $sub->($template_ref);
				} else {
					# modulate
					my @array = map { $_."\n" } split("\n", $$template_ref);
					# call
					$sub->(\@array);
				# demodulate
				$$template_ref = join("", @array);
			}
			};

			croak("HTML::Template->new() : fatal error occured during filter call: $@") if $@;
		} else {
			croak("HTML::Template->new() : bad value set for filter parameter - must be code ref or hash ref");
		}
	}
	# all done
	return $template_ref;
}

sub _quote_string {
	my $string = shift;

	$string =~ s/\\/\\\\/g;
	$string =~ s/"/\\"/g;
	$string =~ s/\$/\\\$/g;
	$string =~ s/\@/\\\@/g;
	$string =~ s/\r/\\r/g;
	$string =~ s/\n/\\n/g;
	$string =~ s/\t/\\t/g;

	return $string;
}  

sub provide_variable {
	my ($options, $variable_count, $name, @contextstack) = @_;
	my $cur_var;

	foreach my $name (@{$name}) {
		if (defined $contextstack[0]->{'POSITION'}->{$name}) {
			my $i;

			for ($i = 0; $i < scalar(@{$contextstack[0]->{'SUBCONTEXT_STACK'}}); $i++) {
				if ($contextstack[0]->{'SUBCONTEXT_STACK'}->[$i] eq $contextstack[0]->{'POSITION'}->{$name}) {
					$i = -1;
					last;
				} elsif ($contextstack[0]->{'SUBCONTEXT_STACK'}->[$i] < $contextstack[0]->{'POSITION'}->{$name}) {
					last;
				}
			}

			if ($i > -1) {
				$contextstack[0]->{'POSITION'}->{$name} = $contextstack[0]->{'SUBCONTEXT_STACK'}->[$i];

				$cur_var = $contextstack[0]->{'VARMAP'}->{$name};
				delete $contextstack[0]->{'VARMAP'}->{$name};
			}
		} else {
			$cur_var = $$variable_count++;
			$contextstack[0]->{'POSITION'}->{$name} = $contextstack[0]->{'SUBCONTEXT_STACK'}->[0];
		}

		unless (defined $contextstack[0]->{'VARMAP'}->{$name}) {
			my $lookup = "\$var$cur_var = ";

			if ($name =~ /^__(FIRST|LAST|INNER|ODD|COUNT)__$/) {
				if ($name eq '__FIRST__') {
					$lookup .= "(\$i_$contextstack[0]->{'CONTEXT_NAME'} == 1) ? 1 : undef;";
				} elsif ($name eq '__LAST__') {
					#$lookup .= "(\$i_$contextstack[0]->{'CONTEXT_NAME'} == scalar(\@{\$Param$contextstack[1]->{'CONTEXT_NAME'}\->{'$contextstack[0]->{'LOOP_NAME'}'}})) ? 1 : undef;";
					$lookup .= "(\$i_$contextstack[0]->{'CONTEXT_NAME'} == scalar(\@{\$\${var" . $contextstack[1]->{'VARMAP'}->{$contextstack[0]->{'LOOP_NAME'}} . "}})) ? 1 : undef;";
				} elsif ($name eq '__INNER__') {
					$lookup .= "((\$i_$contextstack[0]->{'CONTEXT_NAME'} > 1) && (\$i_$contextstack[0]->{'CONTEXT_NAME'} < scalar(\@{\$Param$contextstack[1]->{'CONTEXT_NAME'}\->{'$contextstack[0]->{'LOOP_NAME'}'}}))) ? 1 : undef;";
				} elsif ($name eq '__ODD__') {
					$lookup .= "(\$i_$contextstack[0]->{'CONTEXT_NAME'} & 1) ? 1 : undef;";
				} else {
					$lookup .= "\$i_$contextstack[0]->{'CONTEXT_NAME'};";
				}
			} else {
				if ($options->{global_vars}) {
					my $parent_variable = $contextstack[1]->{'VARMAP'}->{$name};

					if (defined $parent_variable) {
						$contextstack[0]->{'REQUIRED_PARENT_VARS'}->{$name} = 1;
						$lookup .= "(defined \$Param$contextstack[0]->{'CONTEXT_NAME'}\->{'$name'}) ? \\\$Param$contextstack[0]->{'CONTEXT_NAME'}\->{'$name'} : \$var" .  $parent_variable . ";";
					} else {
						$lookup .= "(defined \$Param$contextstack[0]->{'CONTEXT_NAME'}\->{'$name'}) ? \\\$Param$contextstack[0]->{'CONTEXT_NAME'}\->{'$name'} : (defined \$contextstack[0]\->{'$name'}) ? \\\$contextstack[0]\->{'$name'} : HTML::Template::search_parent_context('$name', [\@contextstack]);";
					}
				} else {
					$lookup .= "\\\$Param$contextstack[0]->{'CONTEXT_NAME'}\->{'$name'};"
				}
			}

			$contextstack[0]->{'PERL'}->{$name} = $lookup;
			$contextstack[0]->{'VARMAP'}->{$name} = $cur_var;
		}
	}

	if (scalar(@{$name}) == 1) {
		$name = @{$name}[0];
		if ($name =~ /^__(FIRST|LAST|INNER|ODD|COUNT)__$/) {
			return "\${var$contextstack[0]->{'VARMAP'}->{$name}}";
		} else {
			return "\$\${var$contextstack[0]->{'VARMAP'}->{$name}}";
		}
	}
}

sub complete_context {
my ($package_perl, $Context) = @_;

my %shift;
	foreach my $cur_var (keys %{$Context->{'VARMAP'}}) {
		my $total_shift = 0;

		foreach my $base (keys %shift) {
			$total_shift += $shift{$base} if ($base < $Context->{'POSITION'}->{$cur_var});
		}

		substr $$package_perl, $Context->{'POSITION'}->{$cur_var} + $total_shift, 0, $Context->{'PERL'}->{$cur_var};

		$shift{$Context->{'POSITION'}->{$cur_var}} = ($shift{$Context->{'POSITION'}->{$cur_var}} || 0) + length($Context->{'PERL'}->{$cur_var});
	}
}

# _parse sifts through a template building up the param_map and
# parse_stack structures.
#
# The end result is a Template object that is fully ready for
# output().
sub _parse {
	my $self = shift;
	my $options = $self->{options};

	print STDERR "HTML::Template->new() : _parse $options->{filepath} :)\n" if ($options->{debug});
	
	# all the tags that need NAMEs:
	my %need_names = map { $_ => 1 } 
	  qw(TMPL_VAR TMPL_LOOP TMPL_IF TMPL_UNLESS TMPL_INCLUDE);
	my %need_variable = map { $_ => 1 } 
	  qw(TMPL_VAR TMPL_LOOP TMPL_IF TMPL_UNLESS);
	  
	# variables used below that don't need to be my'd in the loop
	my ($name, $which, $escape, $format);

	# now split up template on '<', leaving them in
	my @chunks = split(m/(?=<)/, $self->{template});

	# all done with template
	delete $self->{template};

	my $variable_count = 0;
	my $open_print;
	my $fname = $options->{filepath} || "/fake/path/for/non/file/template";
	my $fcounter = 1;
	my @dependencies;
	my $variable;

	my (@contextstack, @loopstack);
	unshift @contextstack, { 'CONTEXT_NAME' => 1 };

	my $package_perl = <<END;
package ht$self->{md5_packagename};
# $fname
use integer;
use strict;

our \$mtime = '$self->{mtime}';

sub output {
	my \$Param1 = shift;
	my \@contextstack;
	my \$result;
	my \$tmpl_if;

	unshift \@contextstack, \@_ if (\$#_ > -1);
	unshift \@contextstack, \$Param1;

END

	$contextstack[0]->{'CODE_TOP'} = length($package_perl);
	$contextstack[0]->{'CONTEXT_TOP'} = $contextstack[0]->{'CODE_TOP'};
	unshift @{$contextstack[0]->{'SUBCONTEXT_STACK'}}, $contextstack[0]->{'CONTEXT_TOP'};

	# loop through chunks, filling up pstack
	my $last_chunk = $#chunks;
	for (my $chunk_number = 0; $chunk_number <= $last_chunk; $chunk_number++) {
		next unless defined $chunks[$chunk_number]; 
		my $chunk = $chunks[$chunk_number];
	  
		# a general regex to match any and all TMPL_* tags 
		if ($chunk =~ /^<
	                  (?:!--\s*)?
	                  (
	                    \/?[Tt][Mm][Pp][Ll]_
	                    (?:
	                       (?:[Vv][Aa][Rr])
	                       |
	                       (?:[Ll][Oo][Oo][Pp])
	                       |
	                       (?:[Ii][Ff])
	                       |
	                       (?:[Ee][Ll][Ss][Ee])
	                       |
	                       (?:[Uu][Nn][Ll][Ee][Ss][Ss])
	                       |
	                       (?:[Ii][Nn][Cc][Ll][Uu][Dd][Ee])
	                    )
	                  ) # $1 => $which - start of the tag

	                  \s* 

	                  # ESCAPE attribute
	                  (?:
	                    [Ee][Ss][Cc][Aa][Pp][Ee]
	                    \s*=\s*
	                    (?:
	                       ( 0 | (?:"0") | (?:'0') ) # $2 => ESCAPE off
	                       |
	                       ( 1 | (?:"1") | (?:'1') | 
	                         (?:[Hh][Tt][Mm][Ll]) | 
	                         (?:[Uu][Rr][Ll]) | 
	                         (?:[Cc][Ss][Vv]) | 
	                         (?:[Jj][Ss]) | 
	                       )                         # $3 => ESCAPE on
	                     )
	                  )* # allow multiple ESCAPEs

	                  \s* 

	                  # FORMAT attribute
	                  (?:
	                    [Ff][Oo][Rr][Mm][Aa][Tt]
	                    \s*=\s*
	                    (?:
	                       ( 
	                         (?:[Hh][Tt][Mm][Ll][Ii][Ff][Yy]) | 
	                         (?:[Nn][Uu][Mm][Bb][Ee][Rr]) | 
	                         (?:[Mm][Oo][Nn][Ee][Yy]) | 
	                         (?:[Pp][Ee][Rr][Cc][Ee][Nn][Tt]) | 
	                       )                         # $4 => FORMAT on
	                     )
	                  )* # allow multiple ESCAPEs

	                  \s*
	                  
	                  # NAME attribute
	                  (?:
	                    (?:
	                      [Nn][Aa][Mm][Ee]
	                      \s*=\s*
	                    )?
	                    (?:
	                      "([^">]*)" # $5 => double-quoted NAME value "
	                      |
	                      '([^'>]*)' # $6 => single-quoted NAME value
	                      |
	                      ([^\s=>]*)  # $7 => unquoted NAME value
	                    )
	                  )? 

	                  \s*

	                  (?:--)?>                    
	                  (.*) # $8 => $post - text that comes after the tag
	                 $/sx) {

			$which = uc($1); # which tag is it

			$escape = $3;
			$escape = 0 unless defined($escape);

			$format = $4 || 0;

			# what name for the tag?  undef for a /tag at most, one of the
			# following three will be defined
			undef $name;
			$name = $5 if defined($5);
			$name = $6 if defined($6);
			$name = $7 if defined($7);

			my $post = $8; # what comes after on the line

			# die if we need a name and didn't get one
			die "HTML::Template->new() : No NAME given to a $which tag at $fname : line $fcounter.\n" if (!defined($name) and $need_names{$which});

			# die if we got an escape but can't use one
			die "HTML::Template->new() : ESCAPE option invalid in a $which tag at $fname : line $fcounter.\n" if ( $escape and ($which ne 'TMPL_VAR'));

			if ($need_variable{$which}) {
				$variable = provide_variable($options, \$variable_count, [ $name ], @contextstack);
			}

			# take actions depending on which tag found
			if ($which eq 'TMPL_VAR') {
				if ($escape || $format) {
					my ($escape_func, $format_func);

					if ($escape =~ /^[Uu][Rr][Ll]$/) {
						$escape_func = 'HTML::Template::escape_url';
					} elsif ($escape =~ /^[Hh][Tt][Mm][Ll]$/) {
						$escape_func = 'HTML::Template::escape_html';
					} elsif ($escape =~ /^[Cc][Ss][Vv]$/) {
						$escape_func = 'HTML::Template::escape_csv';
					} elsif ($escape =~ /^[Jj][Ss]$/) {
						$escape_func = 'HTML::Template::escape_js';
					}

					if ($format =~ /^[Hh][Tt][Mm][Ll][Ii][Ff][Yy]$/) {
						$format_func = 'HTML::Template::format_htmlify';
					} elsif ($format =~ /^[Nn][Uu][Mm][Bb][Ee][Rr]$/) {
						$format_func = 'HTML::Template::format_number';
					} elsif ($format =~ /^[Mm][Oo][Nn][Ee][Yy]$/) {
						$format_func = 'HTML::Template::format_money';
					} elsif ($format =~ /^[Pp][Ee][Rr][Cc][Ee][Nn][Tt]$/) {
						$format_func = 'HTML::Template::format_percent';
					}

					if ($open_print) {
						if (substr($package_perl, -4, 4) eq ' . "') {
							$package_perl = substr($package_perl, 0, -1);
						} else {
							$package_perl .= "\" . ";
						}

						$package_perl .= ((defined $escape_func) ? "$escape_func(" : "") . ((defined $format_func) ? "$format_func(" : "") . $variable . ((defined $escape_func) ? ")" : "") . ((defined $format_func) ? ")" : "")  . " . \"";
					} else {
						$package_perl .= "\$result .= " . ((defined $escape_func) ? "$escape_func(" : "") . ((defined $format_func) ? "$format_func(" : "") . $variable . ((defined $escape_func) ? ")" : "") . ((defined $format_func) ? ")" : "")  . " . \"";
						$open_print = 1;
					}
				} else {
					if ($open_print) {
						$package_perl .= $variable;
					} else {
						$package_perl .= "\$result .= \"$variable";
						$open_print = 1;
					}
				}
################################################################################
			} elsif ($which eq 'TMPL_LOOP') {
				unshift @contextstack, { 'CONTEXT_NAME' => $contextstack[0]->{'CONTEXT_NAME'} + 1, 'LOOP_NAME' => $name };
				unshift @loopstack, $#contextstack;

				if ($open_print) {
					if (substr($package_perl, -4, 4) eq ' . "') {
						$package_perl = substr($package_perl, 0, -4);
					} else {
						$package_perl .= "\"";
					}

					$package_perl .= ";";
					$open_print = 0;
				}

				$package_perl .= "if (defined $variable) {";

				$package_perl .= "die \"HTML::Template->output() : TMPL_LOOP $name was passed a reference of type '\" . ref($variable) . \"' instead of ARRAY at $fname : line $fcounter.\n\" if (!(ref($variable) eq 'ARRAY'));" if ($options->{debug});

				$package_perl .= "unshift \@contextstack, \$Param$contextstack[1]->{'CONTEXT_NAME'};" if ($contextstack[1]->{'CONTEXT_NAME'} > 1);
				$package_perl .= "my \$i_$contextstack[0]->{'CONTEXT_NAME'} = 1;" if ($options->{loop_context_vars});
				$package_perl .= "foreach my \$Param$contextstack[0]->{'CONTEXT_NAME'} (\@{$variable}) {";

				$package_perl .= "next if (!(ref(\$Param$contextstack[0]->{'CONTEXT_NAME'}) eq 'HASH'));";

				$contextstack[0]->{'CONTEXT_TOP'} = length($package_perl);
				unshift @{$contextstack[0]->{'SUBCONTEXT_STACK'}}, $contextstack[0]->{'CONTEXT_TOP'};
################################################################################
			} elsif ($which eq '/TMPL_LOOP') {
				if ($loopstack[0] != $#contextstack) {
					die "HTML::Template->new() : Open Contexts at $which at $fname : line $fcounter.\n";
				}

				complete_context(\$package_perl, $contextstack[0]);

				if ($open_print) {
					if (substr($package_perl, -4, 4) eq ' . "') {
						$package_perl = substr($package_perl, 0, -4);
					} else {
						$package_perl .= "\"";
					}

					$package_perl .= ";";
					$open_print = 0;
				}

				$package_perl .= "\$i_$contextstack[0]->{'CONTEXT_NAME'}++;" if ($options->{loop_context_vars});

				my $vars = [keys %{$contextstack[0]->{'REQUIRED_PARENT_VARS'}}];

				shift @loopstack;
				shift @contextstack;

				provide_variable($options, \$variable_count, $vars, @contextstack);

				$package_perl .= "}";
				$package_perl .= "shift \@contextstack;" if ($contextstack[0]->{'CONTEXT_NAME'} > 1);
				$package_perl .= "}";
################################################################################
			} elsif ($which eq 'TMPL_IF' or $which eq 'TMPL_UNLESS' ) {
				if ($open_print) {
					if (substr($package_perl, -4, 4) eq ' . "') {
						$package_perl = substr($package_perl, 0, -4);
					} else {
						$package_perl .= "\"";
					}

					$package_perl .= ";";
					$open_print = 0;
				}

				$package_perl .= (($which eq 'TMPL_IF') ? 'if' : 'unless') . " ((defined $variable) && ((ref($variable) eq 'ARRAY') ? (scalar(\@{$variable}) > 0) : " . ($options->{ifdefined} ? '1' : '$variable') . ")) {";

				unshift @{$contextstack[0]->{'IF_STACK'}}, $which;
				unshift @{$contextstack[0]->{'SUBCONTEXT_STACK'}}, length($package_perl);
################################################################################
			} elsif ($which eq '/TMPL_IF' or $which eq '/TMPL_UNLESS') {
				if (scalar(@{$contextstack[0]->{'IF_STACK'}}) == -1) {
					die "HTML::Template->new() : Dangling /$which at $fname : line $fcounter.\n";
				}

				unless ($which eq '/' . $contextstack[0]->{'IF_STACK'}->[0]) {
					die "HTML::Template->new() : $which closing a $contextstack[0]->{'IF_STACK'}->[0] at $fname : line $fcounter.\n";
				}

				shift @{$contextstack[0]->{'IF_STACK'}};
				shift @{$contextstack[0]->{'SUBCONTEXT_STACK'}};

				if ($open_print) {
					if (substr($package_perl, -4, 4) eq ' . "') {
						$package_perl = substr($package_perl, 0, -4);
					} else {
						$package_perl .= "\"";
					}

					$package_perl .= ";";
					$open_print = 0;
				}

				$package_perl .= "}";
################################################################################
			} elsif ($which eq 'TMPL_ELSE') {
				if (scalar(@{$contextstack[0]->{'IF_STACK'}}) == -1) {
					die "HTML::Template->new() : Open Contexts at $which at $fname : line $fcounter.\n";
				}

				if ($open_print) {
					if (substr($package_perl, -4, 4) eq ' . "') {
						$package_perl = substr($package_perl, 0, -4);
					} else {
						$package_perl .= "\"";
					}

					$package_perl .= ";";
					$open_print = 0;
				}

				$package_perl .= "} else {";

				$contextstack[0]->{'SUBCONTEXT_STACK'}->[0] = length($package_perl);
################################################################################
			} elsif ($which eq 'TMPL_INCLUDE') {
				push @dependencies, $name;

				my @options;
				push @options, 'filename';
				push @options, $name;
				foreach (grep(!/^file(name|path)/, keys %{$options})) {
					push @options, $_;
					push @options, $options->{$_};
				}
				my $template = HTML::Template->new(@options);

				if ($open_print) {
					if (substr($package_perl, -4, 4) eq ' . "') {
						$package_perl = substr($package_perl, 0, -4);
					} else {
						$package_perl .= "\"";
					}

					$package_perl .= ";";
					$open_print = 0;
				}

				$package_perl .= '$result .= ht' . $template->{md5_packagename} . "::output(\$Param$contextstack[0]->{'CONTEXT_NAME'}, \@contextstack);";

################################################################################
			} else {
				# zuh!?
				die "HTML::Template->new() : Unknown or unmatched TMPL construct at $fname : line $fcounter.\n";
			}

			# push the rest after the tag
			if (defined($post) && length($post)) {
				$post = _quote_string($post);

				if ($open_print) {
					$package_perl .= $post;
				} else {
					$package_perl .= "\$result .= \"" . $post;
					$open_print = 1;
				}
			}
		} else { # just your ordinary markup
			$chunk = _quote_string($chunk);

			if ($open_print) {
				$package_perl .= $chunk;
			} else {
				$package_perl .= "\$result .= \"" . $chunk;
				$open_print = 1;
			}
		}

		$fcounter += scalar(@{[$chunk =~ m/()/g]});
	} # next CHUNK

	complete_context(\$package_perl, $contextstack[0]);

	if ($open_print) { $package_perl .= "\""; }
	$package_perl .= <<END;
;

	return \$result;
}

END

	if ($variable_count > 0) {
		my $myvarlist = "my (";
		for (my $i = 0; $i < $variable_count; $i++) { $myvarlist .= "\$var$i, " }
		$myvarlist = substr($myvarlist, 0, -2) . ");";

		substr $package_perl, $contextstack[0]->{'CODE_TOP'}, 0, $myvarlist;
	}

	$package_perl .= "our \@includes = (";
	if ($#dependencies > -1) {
		$package_perl .= "'" . join("','", @dependencies) . "'";
	}
	$package_perl .= ");";

	if ($options->{file_cache} && (defined $options->{file_cache_dir})) {
		unless (-d $options->{file_cache_dir}) {
			mkdir $options->{file_cache_dir};
			chmod $options->{file_cache_dir_mode}, $options->{file_cache_dir};
			chown $options->{file_cache_dir_ownerid}, $options->{file_cache_dir_groupid}, $options->{file_cache_dir};
		}

		open FILE, '>' . $options->{file_cache_dir} . '/ht' . $self->{md5_packagename} . '.pm';
		print FILE $package_perl;
		close FILE;

		chmod $options->{file_cache_file_mode}, $options->{file_cache_dir} . '/ht' . $self->{md5_packagename} . '.pm';
		chown $options->{file_cache_file_ownerid}, $options->{file_cache_file_groupid}, $options->{file_cache_dir} . '/ht' . $self->{md5_packagename} . '.pm';
	} elsif ($options->{debug}) {
		open FILE, '>/tmp/ht' . $self->{md5_packagename} . '.pm';
		print FILE $package_perl;
		close FILE;
	}

	eval $package_perl;
	die "HTML::Template->new() : Created package failed to load: $@\n" if ($@);

	# make sure we don't have dangling IF or LOOP blocks
	scalar(@{$contextstack[0]->{'IF_STACK'}}) and die "HTML::Template->new() : At least one <TMPL_IF> or <TMPL_UNLESS> not terminated at end of file!\n" if (defined $contextstack[0]->{'IF_STACK'});
	scalar(@loopstack) and die "HTML::Template->new() : At least one <TMPL_LOOP> not terminated at end of file!\n";

	# get rid of filters - they cause runtime errors if Storable tries
	# to store them.  This can happen under global_vars.
	delete $options->{filter};

	print STDERR "HTML::Template->new() : _parse $options->{filepath} DONE :)\n" if ($options->{debug});
}

sub param_hash {
	my $self = shift;

	if (($#_ == 0) && (ref($_[0]) eq 'HASH')) {
		$self->{params} = shift;
	} else {
		confess "HTML::Template->param_hash() expects a hash ref";
	}
}

sub param {
	my $self = shift;

	if (($#_ == 0) && (ref($_[0]) eq 'HASH')) {
		foreach (keys %{$_[0]}) {
			$self->{params}->{$_} = $_[0]->{$_}; 
		}
	} elsif ($#_ & 1 == 1) {
		for (my $i = 0; $i < $#_; $i += 2) {
			$self->{params}->{$_[$i]} = $_[$i + 1]; 
		}
	} elsif (($#_ == 0) && ($_[0] eq undef)) {
		return;
	} elsif ($#_ == -1) {
		return;
	} else {
		confess "HTML::Template->param() expects a hash ref or an array!\n";
	}
}

sub output {
	my $self = shift;
	my $options = $self->{options};
	my $output;

	if ($options->{debug}) {
		my $time = new Devel::Timer();

		$output = eval('return ht' . $self->{md5_packagename} . '::output($self->{params})');
		$time->mark("call to ht$self->{md5_packagename}::output() #$options->{filename}# completed");

		$time->report();
	} else {
		$output = eval('return ht' . $self->{md5_packagename} . '::output($self->{params})');
	}

	confess "HTML::Template->output() : Template package ht$self->{md5_packagename}->output call failed ($@).\n" if ($@);

	return $output;
}

# Template utility functions ###################################################
sub search_parent_context {
	my ($VarName, $Parents) = @_;

	foreach my $parent (@{$Parents}) {
		if (defined $parent->{$VarName}) {
			$Parents->[0]->{$VarName} = $parent->{$VarName};
			return \$parent->{$VarName};
		}
	}

	return \$BLANK;
}

our %URLESCAPE_MAP;
sub escape_url {
	my $string = shift;

	# Build a char->hex map if one isn't already available
	unless (exists($URLESCAPE_MAP{chr(1)})) {
		for (0..255) { $URLESCAPE_MAP{chr($_)} = sprintf('%%%02X', $_); }
	}

	# do the translation (RFC 2396 ^uric)
	$string =~ s!([^a-zA-Z0-9_.-])!$URLESCAPE_MAP{$1}!g;

	return $string;
}

sub escape_html {
	my $string = shift;

	$string =~ s/&/&amp;/g;
	$string =~ s/"/&quot;/g; #"
	$string =~ s/>/&gt;/g;
	$string =~ s/</&lt;/g;
	$string =~ s/'/&#39;/g; #'
	$string =~ s/ /&#32;/g; # space

	return $string;
}

sub escape_csv {
	my $string = shift;

	$string =~ s/"/""/g;

	return $string;
}

sub escape_js {
	my $string = shift;

        $string =~ s/\\/\\\\/g;
        $string =~ s/'/\\'/g;
        $string =~ s/"/\\"/g;
        $string =~ s/\n/\\n/g;
        $string =~ s/\r/\\r/g;

	return $string;
}

sub format_htmlify {
	my $string = shift;

	$string =~ s/\n/<BR \/>/g;

	return $string;
}

sub format_number {
	my $string = shift;

	return sprintf("%d", $string);
}

sub format_money {
	my $string = shift;

	my $nf = new Number::Format(-decimal_fill => 1);
	$string = '$' . $nf->format_number($string);

	return $string;
}

sub format_percent {
	my $string = shift;

	$string = sprintf("%.02f%%", $string * 100);

	return $string;
}

# Static Methods ###############################################################
sub preload_directory {
	my ($Directory) = @_;

	# Build that table before forking
	escape_url('');

	if (-d $Directory) {
		opendir DIR, $Directory;

		while (my $name = readdir(DIR)) {
			if ($name =~ /\.tmpl$/) {
				my $template = HTML::Template->new(filename => $Directory . '/' . $name);
			}
		}

		closedir DIR;
	} else {
		return undef;
	}
}

1;

