# FILE: templint.pl
# DESCRIPTION: Template Interpreter (actual conversion to Perl)
#-------------------------------------------------------------------------------
# DISCUS COPYRIGHT NOTICE
#
# Discus is copyright (c) 2002 by DiscusWare, LLC, all rights reserved.
# The use of Discus is governed by the Discus License Agreement which is
# available from the Discus WWW site at:
#    http://www.discusware.com/discus/license
#
# Pursuant to the Discus License Agreement, this copyright notice may not be
# removed or altered in any way.
#-------------------------------------------------------------------------------

use strict;
use vars qw($GLOBAL_OPTIONS $DCONF $PARAMS);

###
### dtlperl
###
### Converts Discus template language into Perl code (manager subroutine)
###

sub dtlperl {
	my $templatename = shift @_;
	performance_string("* Calculating DTL->Perl for $templatename");
	my @k = dtl_to_perl('text', 'substitutions', @_);
	$templatename =~ s/\W/_/g;
	unshift @k, "\$GLOBAL_OPTIONS = \$main::GLOBAL_OPTIONS;\n";
	unshift @k, "\$DCONF = \$main::DCONF;\n";
	unshift @k, "\$PARAMS = \$main::PARAMS;\n";
	unshift @k, "use vars qw(\$GLOBAL_OPTIONS \$PARAMS \$DCONF);\n";
	unshift @k, "use strict;\n";
	unshift @k, "package $templatename;\n";
	push @k, "return (\"\$text\\n\", \$substitutions);\n";
	push @k, "}\n";
	my @export = qw/element_array_grep getgmtoffset _minimath wordwrapper reference_array_from mathdefine program_sub does_part_exist template_error template_includer template_css_size file_includer case_l case_u remove_html template_js_prepare get_date_time maxcharcut nohtmllength substrnohtml safe_minus_one process_math read_language skin_includer picker form_escape escape unescape/;
	foreach my $x (@export) {
		push @k, "sub $x { return &main'$x }\n";
	}
	push @k, "1;\n";
	return beautify(@k);
}

###
### beautify
###
### Produces more attractive Perl code (brackets in the right place)
###

sub beautify {
	my @out = ();
	my $indent = 0;
	my @A = split(/\n/, join("", @_));
	while (my $x = shift @A) {
		$x = trim ($x);
		if ($x =~ /^\}.*\{$/) {
			push @out, join("", "\t" x ($indent-1), $x, "\n");
		} elsif ($x =~ /\{$/) {
			push @out, join("", "\t" x $indent, $x, "\n");
			$indent += 1;
		} elsif ($x =~ /\{\s*#/) {
			push @out, join("", "\t" x $indent, $x, "\n");
			$indent += 1;
		} elsif ($x =~ /^\}(\s*)#/) {
			push @out, join("", "\t" x ($indent-1), $x, "\n");
			$indent -= 1;
		} elsif ($x =~ /^\}$/) {
			push @out, join("", "\t" x ($indent-1), $x, "\n");
			$indent -= 1;
		} else {
			push @out, join("", "\t" x $indent, $x, "\n");
		}
	}
	return @out;
}

###
### dtl_to_perl
###
### Actual conversion of template language into Perl
###

sub dtl_to_perl {
	my $textvar = shift @_;
	my $substvar = shift @_;
	my @whilecond = ();
	my @subroutine = ();
	my @l = @_;
	my @out = ();
	my @outhead = ();
	if ($textvar eq 'text') {
		while (my $z = shift @l) {
			last if $z =~ /^\s*<!--BEGIN-->\s*/i;
		}
		push @outhead, "sub process {\n";
		push @outhead, "  my \$substitutions = shift \@_;\n";
		push @outhead, "  my \$$textvar = \"\";\n";
	}
	my @ifs = ();
WO:	while ($_ = shift @l) {
		return (@subroutine, @outhead, @whilecond, @out) if /^\s*<!--END-->\s*$/i;
		if (/^\rPERL\r/i) {
			push @out, $';
			next;
		}
		if (m|^\s*<#\s*dtl\s*off\s*#>\s*$|i) {
			while (my $z = shift @l) {
				next WO if $z =~ m|^\s*<#\s*dtl\s*on\s*#>\s*$|i;
				$z =~ s/\\/\\\\/g; $z =~ s/'/\\'/g;
				push @out, join("", "\$$textvar .= '", $z, "';", "\n");
			}
		}
		if (m|^\s*<#\s*perl\s*#>\s*$|i) {
			while (my $z = shift @l) {
				next WO if $z =~ m|^\s*<#\s*/\s*perl\s*#>\s*$|i;
				push @out, $z;
			}
		} elsif (m|^\s*<#\s*no\s*perl\s*#>\s*$|i) {
			while (my $z = shift @l) {
				next WO if $z =~ m|^\s*<#\s*/\s*no\s*perl\s*#>\s*$|i;
			}
		}
		next if /^\s*<#\s*simple\s*variables\s*#>\s*$/i;
		next if m|^\s*#|;
		next if ! m|\S|;
		$_ = join("", $`, "\n") if /\s*##/;
		$_ = $` if /\s*\\\s*$/;
		s/<#>/#/g;
		if (m|^\s*<#sub \s*(.*)\s*#>\s*$|i) {
			template_error("Subroutine definition in wrong place for $1") if $textvar ne 'text';
			my $subargs = $1;
			template_error("Illegal subroutine definition for $subargs") if $subargs !~ m|^(\w+)\s*\(([\s\$\w\,]*)\)\s*$|;
			my ($subname, $subarg) = (lc($1), $2);
			return () if defined $PARAMS->{subs}->{$subname};
			$PARAMS->{arraycounter} += 1;
			$PARAMS->{subs}->{$subname} = "SUBR$PARAMS->{arraycounter}";
			push @subroutine, "sub SUBR$PARAMS->{arraycounter} {\n";
			push @subroutine, "  my \$substitutions = shift \@_;\n";
			push @subroutine, "  my \$subtextout = \"\";\n";
			foreach my $arg (split /,/, $subarg) {
				$arg = trim($arg); $arg =~ s/^\$//;
				push @subroutine, "  \$substitutions->{\"_\"}->{$arg} = shift \@_;\n";
			}
			my @arr = ();
SDEF:		while ($_ = shift @l) {
				last SDEF if m|^\s*<#\s*end\s*sub\s*#>\s*$|i;
				push @arr, $_;
			}
			push @subroutine, dtl_to_perl('subtextout', 'substitutions', @arr);
			push @subroutine, "  return \$subtextout;\n";
			push @subroutine, "} ## End of SUBR$PARAMS->{arraycounter} (name: $subname)\n";
			next WO;
		}
		if (m%\s*<#define%) {
			my $line = "";
			if (m|^\s*<#define\s+\$(\w+)\s*=\s*"?(.*?)"?#>\s*$|i) {
				$line = "\$substitutions->{\"_\"}->{$1} = ";
				$line .= dtl_var_replace($2);
				$line .= ";\n";
			} elsif (m|^\s*<#define\s+\$(\w+)\s*\[\s*(.*?)\s*\]\s*=\s*"?(.*?)"?#>\s*$|i) {
				$line = "if ( ";
				$line .= dtl_var_replace($2);
				$line .= " >= 0) {\n";
				$line .= "\$substitutions->{$1}->[-1+";
				$line .= dtl_var_replace($2);
				$line .= "] = ";
				$line .= dtl_var_replace($3);
				$line .= ";\n}\n";
			} elsif (m|^\s*<#define\s*array\s*\@(\w+)\s*\(([\w\s,]+)\)\s*#>\s*$|i) {
				my ($arrayname, $fieldnames) = ($1, $2);
				$PARAMS->{arraycounter} += 1;
				my $arraycounter = $PARAMS->{arraycounter};
				$line .= "{\nmy \@ARRAY$arraycounter = ();\n";
				$line .= "my \$hashref;\n";
				$fieldnames =~ s/\s//g;
				my @fieldnames = split(/,/, $fieldnames);
				template_error("Array \@$arrayname does not have any field names defined!") if scalar(@fieldnames) < 1;
WDEF:			while ($_ = shift @l) {
					if (m|^\s*<#/define#>\s*$|i) {
						$line .= "\$substitutions->{$arrayname} = \\\@ARRAY$arraycounter;\n}\n";
						push @out, $line;
						next WO;
					} elsif (m|^\s*<#define|) {
						template_error("Cannot nest definitions in defining \@$arrayname!");
					} elsif (m|^\s*<#if([^>]+)#>\s*$|i || m|^\s*<#else#>\s*$| || m|^\s*<#endif#>\s*$|i) {
						template_error("Block IF-THEN-ELSE statements not permitted within array definitions, in defining \@$arrayname!");
					} elsif (m|^\s*<#foreach\s*|i || m|^\s*<#endloop#>\s*$|i) {
						template_error("FOREACH statements not permitted within array definitions, in defining \@$arrayname!");
					} elsif (m|^\s*<#for\s*|i || $line =~ m|^\s*<#endfor#>\s*$|i) {
						template_error("FOR statements not permitted within array definitions, in defining \@$arrayname!");
					}
					chomp; my @linesplits = split(/\t/, $_);
					my $if_flag = 0;
					if ($linesplits[0] =~ m|^\s*<#if *(.*?)#>\s*$|i) {
						$if_flag = 1;
						$line .= dtl_if_replace($1);
						shift @linesplits;
					}
					$line .= "\$hashref = {};\n";
					foreach my $key (@fieldnames) {
						my $t = shift @linesplits;
						if ($t =~ /NO MATCHER[<\{]#if/) {
							$_ = $t;
							my @Q = ();
							if (my @z = m|^\s*(.*?)[<\{]#if (.*?)#[>\}]( *)(.*?)( *)[<\{]#else#[>\}]( *)(.*?)( *)[<\{]#endif#[>\}]( *)(.*?)(\s*)$|) {
								unshift @z, "";
								push @Q, join("", "\$hashref->{$key} .= ", dtl_var_replace($z[1]), ";\n") if $z[1] ne "";
								push @Q, dtl_if_replace($z[2]);
								push @Q, "\$hashref->{$key} .= \"$z[3]\";\n" if $z[3] ne "";
								push @Q, join("", "\$hashref->{$key} .= ", dtl_var_replace($z[4]), ";\n") if $z[4] ne "";
								push @Q, "\$hashref->{$key} .= \"$z[5]\";\n" if $z[5] ne "";
								push @Q, "} else {\n";
								push @Q, "\$hashref->{$key} .= \"$z[6]\";\n" if $z[6] ne "";
								push @Q, join("", "\$hashref->{$key} .= ", dtl_var_replace($z[7]), ";\n") if $z[7] ne "";
								push @Q, "\$hashref->{$key} .= \"$z[8]\";\n" if $z[8] ne "";
								push @Q, "}\n";
								push @Q, "\$hashref->{$key} .= \"$z[9]\";\n" if $z[9] ne "";
								push @Q, join("", "\$hashref->{$key} .= ", dtl_var_replace($z[10]), ";\n") if $z[10] ne "";
								push @Q, join("", "\$hashref->{$key} .= \"\\n\";\n") if $z[11] ne "";
							} elsif (my @z = m|^\s*(.*?)[<\{]#if (.*?)#[>\}]( *)(.*?)( *)[<\{]#endif#[>\}]( *)(.*?)(\s*)$|) {
								unshift @z, "";
								push @Q, join("", "\$hashref->{$key} .= ", dtl_var_replace($z[1]), ";\n") if $z[1] ne "";
								push @Q, dtl_if_replace($z[2]);
								push @Q, "\$hashref->{$key} .= \"$z[3]\";\n" if $z[3] ne "";
								push @Q, join("", "\$hashref->{$key} .= ", dtl_var_replace($z[4]), ";\n") if $z[4] ne "";
								push @Q, "\$hashref->{$key} .= \"$z[5]\";\n" if $z[5] ne "";
								push @Q, "}\n";
								push @Q, "\$hashref->{$key} .= \"$z[6]\";\n" if $z[6] ne "";
								push @Q, join("", "\$hashref->{$key} .= ", dtl_var_replace($z[7]), ";\n") if $z[7] ne "";
								push @Q, join("", "\$hashref->{$key} .= \"\\n\";\n") if $z[8] ne "";
							} elsif (my @z = m|^\s*(.*?)[<\{]#if (.*?)#[>\}]( *)(.*?)(\s*)$|) {
								unshift @z, "";
								push @Q, join("", "\$hashref->{$key} .= ", dtl_var_replace($z[1]), ";\n") if $z[1] ne "";
								push @Q, dtl_if_replace($z[2]);
								push @Q, "\$hashref->{$key} .= \"$z[3]\";\n" if $z[3] ne "";
								push @Q, join("", "\$hashref->{$key} .= ", dtl_var_replace($z[4]), ";\n") if $z[4] ne "";
								push @Q, join("", "\$hashref->{$key} .= \"\\n\";\n") if $z[5] ne "";
								push @Q, "}\n";
							}
							$line .= join("", @Q);
						} else {
							$line .= "\$hashref->{$key} = ";
							$line .= dtl_var_replace($t);
							$line .= ";\n";
						}
					}
					$line .= "if (defined \$hashref->{'_index'}) {\n";
					$line .= "   \$ARRAY$arraycounter";
					$line .= "[\$hashref->{'_index'} - 1] = \$hashref;\n";
					$line .= "} else {\n";
					$line .= "   push \@ARRAY$arraycounter, \$hashref;\n";
					$line .= "}\n";
					$line .= "}\n" if $if_flag;
				}
			} elsif (m|^\s*<#define\s*\$GLOBAL_OPTIONS(?:->)?\{(\w+)\}\s*=\s*"?(.*?)"?\s*#>\s*$|i) {
				$line .= "if (\$GLOBAL_OPTIONS->{skinvar_override_option} != 0) {\n";
				$line .= "   \$GLOBAL_OPTIONS->{$1} = \"";
				my $var_replace = dtl_var_replace($2);
				$var_replace = $2 if $var_replace =~ m|^(['"])(.*?)(\1)$|;
				$line .= $var_replace;
				$line .= "\";\n}\n";
			}
			push @out, $line;
			next;
		} elsif (! m|[<\{]#endif#[>\}]|i && m|^\s*<#if (.*)#>\s*$|) {
			push @out, dtl_if_replace($1);
			push @ifs, $1;
			next;
		} elsif (m|^\s*<#else#>\s*$|i) {
			if ($#ifs >= 0) {
				push @out, "} else {\n";
				next;
			}
			template_error("Invalid &lt;#else#&gt; statement does not match &lt;#if...#&gt; statement");
		} elsif (m|^\s*<#endif#>\s*$|i) {
			if ($#ifs >= 0) {
				push @out, "}\n";
				pop @ifs;
				next;
			}
			template_error("Invalid &lt;#endif#&gt; statement does not match &lt;#if...#&gt; statement");
		} elsif (my @z = m|^!\s*(.*?)[<\{]#if (.*?)#[>\}]( *)(.*?)( *)[<\{]#else#[>\}]( *)(.*?)( *)[<\{]#endif#[>\}]( *)(.*?)(\s*)$|) {
			unshift @z, "";
			push @out, join("", "\$$textvar .= ", dtl_var_replace($z[1]), ";\n") if $z[1] ne "";
			push @out, dtl_if_replace($z[2]);
			push @out, "\$$textvar .= \"$z[3]\";\n" if $z[3] ne "";
			push @out, join("", "\$$textvar .= ", dtl_var_replace($z[4]), ";\n") if $z[4] ne "";
			push @out, "\$$textvar .= \"$z[5]\";\n" if $z[5] ne "";
			push @out, "} else {\n";
			push @out, "\$$textvar .= \"$z[6]\";\n" if $z[6] ne "";
			push @out, join("", "\$$textvar .= ", dtl_var_replace($z[7]), ";\n") if $z[7] ne "";
			push @out, "\$$textvar .= \"$z[8]\";\n" if $z[8] ne "";
			push @out, "}\n";
			push @out, "\$$textvar .= \"$z[9]\";\n" if $z[9] ne "";
			push @out, join("", "\$$textvar .= ", dtl_var_replace($z[10]), ";\n") if $z[10] ne "";
			push @out, join("", "\$$textvar .= \"\\n\";\n") if $z[11] ne "";
			next;
		} elsif (my @z = m|^!\s*(.*?)[<\{]#if (.*?)#[>\}]( *)(.*?)( *)[<\{]#endif#[>\}]( *)(.*?)(\s*)$|) {
			unshift @z, "";
			push @out, join("", "\$$textvar .= ", dtl_var_replace($z[1]), ";\n") if $z[1] ne "";
			push @out, dtl_if_replace($z[2]);
			push @out, "\$$textvar .= \"$z[3]\";\n" if $z[3] ne "";
			push @out, join("", "\$$textvar .= ", dtl_var_replace($z[4]), ";\n") if $z[4] ne "";
			push @out, "\$$textvar .= \"$z[5]\";\n" if $z[5] ne "";
			push @out, "}\n";
			push @out, "\$$textvar .= \"$z[6]\";\n" if $z[6] ne "";
			push @out, join("", "\$$textvar .= ", dtl_var_replace($z[7]), ";\n") if $z[7] ne "";
			push @out, join("", "\$$textvar .= \"\\n\";\n") if $z[8] ne "";
			next;
		} elsif (my @z = m|^!\s*(.*?)[<\{]#if (.*?)#[>\}]( *)(.*?)(\s*)$|) {
			unshift @z, "";
			push @out, join("", "\$$textvar .= ", dtl_var_replace($z[1]), ";\n") if $z[1] ne "";
			push @out, dtl_if_replace($z[2]);
			push @out, "\$$textvar .= \"$z[3]\";\n" if $z[3] ne "";
			push @out, join("", "\$$textvar .= ", dtl_var_replace($z[4]), ";\n") if $z[4] ne "";
			push @out, join("", "\$$textvar .= \"\\n\";\n") if $z[5] ne "";
			push @out, "}\n";
			next;
		} elsif (m|^\s*<#language\s*:\s*\$L(?:->)?\{(\w+)\}\s*=?\s*"(.*?)"\s*#>\s*$|i) {
			push @out, "if (! defined \$PARAMS->{L}->{$1} ) {\n";
			push @out, join("", "\$PARAMS->{L}->{$1} = ", dtl_var_replace($2), ";\n");
			push @out, "}\n";
			next;
		} elsif (m|^\s*<#mathdefine:?\s*\$(\w+)\s*=\s*(.*?)\s*#>\s*$|i) {
			push @out, join("", "\$substitutions->{\"_\"}->{$1} = mathdefine(", dtl_var_replace($2), ", \$substitutions);\n");
			next;
		} elsif (m|^\s*<#key\s+replace\s*\$(\w+)\s*"(.*?)"\s*[-=]\s*>\s*"(.*?)"\s*#>|i) {
			push @out, join("", "\$substitutions->{$1}->{$3} = \$substitutions->{$1}->{$2};\n");
			next;
		} elsif (m|^\s*<#math:\s*(.*?)\s*#>\s*$|i) {
			my ($one) = $1; $one =~ s/'/\\'/g;
			push @out, "\$substitutions = process_math('$one', \$substitutions);\n";
			next;
		} elsif (m|^\s*<#\s*replace\s*"(.*?)"\s*with\s*"(.*?)"\s*in\s*\$(.*?)\s*#>\s*$|i) {
			my ($oldpattern, $newpattern, $variablename) = ($1, $2, $3);
			my $q = quotemeta($oldpattern);
			my $Z = dtl_var_replace($newpattern);
			if ($Z =~ /\r\"\r(.*)\r\"\r/) {
				$Z = join("", "join(\"\", \"", $1, "\")");
			} elsif ($Z =~ /"(.*)"/) {
				$Z = "join(\"\", \"$1\")";
			}
			$Z =~ s/\//\\\//g;
			push @out, "\$substitutions->{\"_\"}->{$variablename} =~ s/$q/$Z/ge;\n";
			next;
		} elsif (m|^\s*<#reference\s*array\s*\@(\w+)\s+from\s*(.*?)\s*except\s*(.*?)\s*=\s*\((.*?)\)\s*#>\s*$|i) {
			my ($arrayname, $arrayfrom, $field, $except) = ($1, $2, $3, $4);
			my $Z = dtl_var_replace($arrayfrom);
			$Z = $1 if $Z =~ /"(.*)"/;
			push @out, "\$substitutions = reference_array_from(\"$arrayname\", $Z, \"$field\", \"$except\", \$substitutions);\n";
			next;
		} elsif (m|^\s*<#reference\s*array\s*\@(\w+)\s+from\s*(.*?)\s*#>\s*$|i) {
			my ($arrayname, $arrayfrom, $field) = ($1, $2, $3);
			my $Z = dtl_var_replace($arrayfrom);
			$Z = $1 if $Z =~ /"(.*)"/;
			push @out, "\$substitutions = reference_array_from(\"$arrayname\", $Z, \"$field\", undef, \$substitutions);\n";
			next;
		} elsif (m|^\s*<#include file[= ]+"(.*)"\s*([\w, ]*)#>\s*$|) {
			my $filename = dtl_var_replace($1);
			push @out, "\$$textvar .= file_includer($filename, \"$2\");\n";
			next;
		} elsif (m|^\s*<#\s*insert\s*(once)?\s*part\s*\((.*?)\)\s*"([^"]+)"\s*\(?(1?)\)?\s*#>\s*$|i) {
			my ($once, $topic, $part, $flag) = ($1, $2, $3, $4);
			$topic = dtl_var_replace($topic) if $topic ne "";
			$topic = "\"\"" if $topic eq "";
			push @out, "{\nmy (\$textSKIN, \$subst) = skin_includer($topic, \"$part\", \$substitutions);\n";
			push @out, "\$$textvar .= \$textSKIN; \$substitutions = \$subst;\n}\n";
			next;
		} elsif (m|^\s*<#\s*insert\s*template\s*"([^"]+)"\s*#>\s*$|i) {
			my $template = dtl_var_replace($1);
			push @out, "\$$textvar .= template_includer($template, \$substitutions);\n";
			next;
		} elsif (m|^\s*<#form\s*variables#>\s*$|) {
			$PARAMS->{arraycounter} += 1;
			my $line = "foreach my \$LOOPVAR$PARAMS->{arraycounter} (keys %{ \$substitutions->{FORMref}) {\n";
			$line .= "  \$$textvar .= \"<input type=hidden name='\$LOOPVAR$PARAMS->{arraycounter}' value='\$substitutions->{FORMref}->{\$LOOPVAR$PARAMS->{arraycounter}";
			$line .= "}'>\\n\";\n}\n";
			push @out, $line;
			next;
		} elsif (m|^\s*<#form\s*variables\(([\w,]+)\)#>\s*$|) {
			my @keylist = split(/,/, $1);
			$PARAMS->{arraycounter} += 1;
			my $line = "my \@FORMVARS$PARAMS->{arraycounter} = qw (";
			$line .= join(" ", @keylist);
			$line .= ");\n";
			push @out, $line;
			push @out, "foreach my \$LOOPVAR$PARAMS->{arraycounter} (\@FORMVARS$PARAMS->{arraycounter}) {\n";
			push @out, "  \$$textvar .= \"<input type=hidden name='\$LOOPVAR$PARAMS->{arraycounter}' value='\$substitutions->{FORMref}->{\$LOOPVAR$PARAMS->{arraycounter}";
			push @out, "}'>\\n\";\n}\n";
			next;
		} elsif (m|^\s*<#skipto\s*"?(\w+)"?#>\s*$|i) {
			if (! defined $PARAMS->{labels}->{lc($1)}) {
				$PARAMS->{arraycounter} += 1;
				$PARAMS->{labels}->{lc($1)} = "LABEL$PARAMS->{arraycounter}";
			}
			push @out, join("", "last ", $PARAMS->{labels}->{lc($1)}, ";\n");
			next;
		} elsif (m|^\s*<#label "?(\w+)"?\s*#>\s*$|i) {
			if (scalar @ifs) {
				my $z = pop @ifs;
				template_error("Label $1 not permitted within IF block &lt;#if $z#&gt;");
			}
			if (! defined $PARAMS->{labels}->{lc($1)}) {
				$PARAMS->{arraycounter} += 1;
				$PARAMS->{labels}->{lc($1)} = "LABEL$PARAMS->{arraycounter}";
			}
			push @out, join("", "last ", $PARAMS->{labels}->{lc($1)}, ";\n");
			push @out, join("", "}  ## LABEL ", $PARAMS->{labels}->{lc($1)}, "\n");
			unshift @whilecond, join("", $PARAMS->{labels}->{lc($1)}, ":  { ## '$1'\n");
			next;

		} elsif (m|^\s*<#foreach\s+\$(\w+)\s+\(\@(\w+)\)#>\s*$|i) {
			$PARAMS->{arraycounter} += 1;
			my ($iterval, $arrayname) = ($1, $2);
			push @out, "if (ref \$substitutions->{$arrayname} eq 'ARRAY') {\n";
			my @t = (); my $fenest = 0;
WSL:		while ($_ = shift @l) {
				if (m|^\s*<#foreach\s+\$(\w+)\s+\(\@(\w+)\)#>\s*$|i) {
					$fenest += 1; push @t, $_;
				} elsif (m|^\s*<#endloop#>\s*$|i) {
					$fenest -= 1;
					if ($fenest < 0) {
						my $achold = $PARAMS->{arraycounter};
						push @out, "  my \@ARRAY$PARAMS->{arraycounter} = \@{ \$substitutions->{$arrayname} };\n";
						push @out, "  my \$MAXINDEX$PARAMS->{arraycounter} = \$#ARRAY$PARAMS->{arraycounter};\n";
						push @out, "  my \$ITERATION$PARAMS->{arraycounter} = 1;\n";
						push @out, "  my \$TEXT$PARAMS->{arraycounter} = \"\";\n";
						push @out, "  my \$ITER$PARAMS->{arraycounter} = 1;\n";
						push @out, "  my \$HOLD$PARAMS->{arraycounter} = \$substitutions->{$iterval};\n";
						push @out, "LOOP$PARAMS->{arraycounter}:  for (my \$INDEX$PARAMS->{arraycounter} = 0; \$INDEX$PARAMS->{arraycounter} <= \$MAXINDEX$PARAMS->{arraycounter}; \$INDEX$PARAMS->{arraycounter} += 1) {\n";
						push @out, join("", "    \$substitutions->{$iterval} = \$ARRAY$PARAMS->{arraycounter}", "[\$INDEX$PARAMS->{arraycounter}];\n");
						push @out, "    \$substitutions->{$iterval}->{_internal_counter} = \$INDEX$PARAMS->{arraycounter};\n";
						push @out, "    \$substitutions->{$iterval}->{_is_last_element} = \$INDEX$PARAMS->{arraycounter} == \$MAXINDEX$PARAMS->{arraycounter} ? 1 : 0;\n";
						push @out, "    \$substitutions->{$iterval}->{_is_first_element} = \$INDEX$PARAMS->{arraycounter} == 0 ? 1 : 0;\n";
						push @out, join("", "    \$substitutions->{$iterval}->{_previous_element} = \$INDEX$PARAMS->{arraycounter} > 0 ? \$ARRAY$PARAMS->{arraycounter}", "[\$INDEX$PARAMS->{arraycounter}-1] : \$ARRAY$PARAMS->{arraycounter}", "[0];\n");
						push @out, join("", "    \$substitutions->{$iterval}->{_next_element} = \$INDEX$PARAMS->{arraycounter} < \$MAXINDEX$PARAMS->{arraycounter} ? \$ARRAY$PARAMS->{arraycounter}", "[\$INDEX$PARAMS->{arraycounter}+1] : \$ARRAY$PARAMS->{arraycounter}", "[\$MAXINDEX$PARAMS->{arraycounter}];\n");
						push @out, "    \$substitutions->{$iterval}->{_iteration} = \$ITERATION$PARAMS->{arraycounter};\n";
						push @out, "    \$substitutions->{$iterval}->{_iteration_minus1} = \$ITERATION$PARAMS->{arraycounter} - 1;\n";
						push @out, join("", dtl_to_perl("TEXT$achold", "fe$achold", @t));
						push @out, "    \$ITERATION$achold += \$ITER$achold;\n";
						push @out, "  } ## End of LOOP$achold\n  \$$textvar .= \$TEXT$achold;\n";
						push @out, "  \$substitutions->{$iterval} = \$HOLD$achold;\n";
						push @out, "} else {\n";
						push @out, "  template_error(\"foreach over '\\\@$arrayname' does not point to array\");\n";
						push @out, "}\n";
						next WO;
					} else {
						push @t, $_;
					}
				} elsif ($fenest == 0 && m|^\s*<#next#>\s*|i) {
					push @t, "\rPERL\rnext LOOP$PARAMS->{arraycounter};\n";
				} elsif ($fenest == 0 && m|^\s*<#last#>\s*|i) {
					push @t, "\rPERL\rlast LOOP$PARAMS->{arraycounter};\n";
				} elsif ($fenest == 0 && m|^\s*<#skip\s*iteration#>\s*$|i) {
					push @t, "\rPERL\r\$ITER$PARAMS->{arraycounter} = 0;\n";
				} else {
					push @t, $_;
				}
			}
			template_error("Unterminated &lt;#foreach#&gt; statement (iterating over $iterval)");

		} elsif (m|^\s*<#while\s*\((.*)\)\s*#>\s*$|i) {
			$PARAMS->{arraycounter} += 1;
			my $cond = $1;
			my @t = (); my $fenest = 0;
			while ($_ = shift @l) {
				if (m|^\s*<#while\s*\((.*)\)\s*#>\s*$|i) {
					$fenest += 1; push @t, $_;
				} elsif (m|^\s*<#/while#>\s*$|i) {
					$fenest -= 1;
					if ($fenest < 0) {
						my $achold = $PARAMS->{arraycounter};
						my $x = dtl_if_replace($cond);
						$x = $1 if $x =~ /^.*?\((.*)\)\s*\{\s*$/;
						push @out, "  my \$whilecounter$achold = 0;\n";
						push @out, "  my \$TEXT$achold = \"\";\n";
						push @out, "  LOOP$achold: while (\$whilecounter$achold <= 5000 && ($x)) {\n";
						push @out, "    \$whilecounter$achold += 1;\n";
						push @out, join("", dtl_to_perl("TEXT$achold", "wh$achold", @t));
						push @out, "  } ## End of LOOP$achold\n  \$$textvar .= \$TEXT$achold;\n";
						next WO;
					} else {
						push @t, $_;
					}
				} elsif ($fenest == 0 && m|^\s*<#next#>\s*|i) {
					push @t, "\rPERL\rnext LOOP$PARAMS->{arraycounter};\n";
				} elsif ($fenest == 0 && m|^\s*<#last#>\s*|i) {
					push @t, "\rPERL\rlast LOOP$PARAMS->{arraycounter};\n";
				} else {
					push @t, $_;
				}
			}
			template_error("Unterminated &lt;#while#&gt; statement (iterating over $cond)");

		} elsif (m|^\s*<#for\s+\$(\w+)\s*=\s*(.*?)\s+to\s+(.*?)\s+step\s+(.*?)\s*#>\s*$|i) {
			$PARAMS->{arraycounter} += 1;
			my ($varname, $start, $end, $step) = ($1, $2, $3, $4);
			my @t = (); my $fenest = 0;
			while ($_ = shift @l) {
				if (m|^\s*<#for\s+\$(\w+)\s*=\s*(.*?)\s+to\s+(.*?)\s+step\s+(.*?)\s*#>\s*$|i) {
					$fenest += 1; push @t, $_;
				} elsif (m|^\s*<#end\s*for#>\s*$|i) {
					$fenest -= 1;
					if ($fenest < 0) {
						my $achold = $PARAMS->{arraycounter};
						$start = dtl_var_replace($start);
						$end = dtl_var_replace($end);
						$step = dtl_var_replace($step);
						my $itervar = join("", "\$for", $achold, "iter");
						push @out, join("", "  my \$for$achold", "step = $step;\n");
						push @out, join("", "  template_error(\"Step size cannot be zero in for loop $varname\") if \$for$achold", "step == 0;\n");
						push @out, "my \@tarr = ();\n";
						push @out, join("", "  if (\$for$achold", "step < 0) {\n");
						push @out, join("", "for (my $itervar = $start; $itervar >= $end; $itervar += $step) {\n");
						push @out, "push \@tarr, $itervar;\n";
						push @out, "}\n";
						push @out, join("", "  } else {\n");
						push @out, join("", "for (my $itervar = $start; $itervar <= $end; $itervar += $step) {\n");
						push @out, "push \@tarr, $itervar;\n";
						push @out, "}\n";
						push @out, "}\n";
						push @out, "my \$counter = 1;\n";
						push @out, "my \$TEXT$achold = \"\";\n";
						push @out, "LOOP$achold: foreach my $itervar (\@tarr) {\n";
						push @out, "\$substitutions->{\"_\"}->{$varname} = $itervar;\n";
						push @out, "\$substitutions->{$varname}->{value} = $itervar;\n";
						push @out, "\$substitutions->{$varname}->{_internal_counter} = \$counter - 1;\n";
						push @out, "\$substitutions->{$varname}->{_iteration} = \$counter;\n";
						push @out, "\$substitutions->{$varname}->{_iteration_minus1} = \$counter - 1;\n";
						push @out, "\$substitutions->{$varname}->{_is_last_element} = \$counter == scalar \@tarr ? 1 : 0;\n";
						push @out, "\$substitutions->{$varname}->{_is_first_element} = \$counter == 0 ? 1 : 0;\n";
						push @out, dtl_to_perl("TEXT$achold", "for$achold", @t);
						push @out, "\$counter += 1;\n";
						push @out, join("", "  } ## end LOOP$achold\n");
						push @out, "\$$textvar .= \$TEXT$achold;\n";
						next WO;
					} else {
						push @t, $_;
					}
				} elsif ($fenest == 0 && m|^\s*<#next#>\s*|i) {
					push @t, "\rPERL\rnext LOOP$PARAMS->{arraycounter};\n";
				} elsif ($fenest == 0 && m|^\s*<#last#>\s*|i) {
					push @t, "\rPERL\rlast LOOP$PARAMS->{arraycounter};\n";
				} else {
					push @t, $_;
				}
			}
			template_error("Unterminated &lt;#for#&gt; statement (iterating over $varname)");
		} elsif (/^\s*<#exit#>\s*$/i) {
			push @out, "  return (\"\$$textvar\\n\", \$substitutions);\n";
			next;
		}
		push @out, join("", "\$$textvar .= ", dtl_var_replace($_), ";\n");
	}
	return (@subroutine, @outhead, @whilecond, @out);
}

###
### dtl_if_replace
###
### Generates appropriate 'if' statements
###

sub dtl_if_replace {
	my $hash = 0;
	if (ref $_[0] eq 'HASH') {
		$hash = 1; shift @_;
	}
	$_ = shift @_;
	my $result = "";
	my @u = split(/ *(?:\|\||\&\&) */, $_);
	my @v = (); while (m/(\|\||\&\&)/g) { push @v, $1; }
	my $flag = 0;
	my $y = "==|!=|>|<|>=|<=|eq|ne|gt|ge|lt|le|rexp=~|rexp!~|=~|!~";
	while (my $u = shift @u) {
		my $v = shift @v;
		next if $u !~ /\S/;
		my $thisresult = "";
		if ($u =~ /^\s*(\(?)\s*pro\s*(\)?)\s*$/) {
			$result .= "$1 \$DCONF->{pro} == 1 $2";
			$result .= $v if $v;
		} elsif ($u =~ /^\s*(\(?)\s*!\s*pro\s*(\)?)\s*$/) {
			$result .= "$1 \$DCONF->{pro} == 0 $2";
			$result .= $v if $v;
		} elsif ($u =~ /^\s*(\(?)\s*(.*?)\s+($y)\s+(.*?)\s*(\)?)\s*$/o) {
			my ($paren1, $var1, $cond, $var2, $paren2) = ($1, $2, $3, $4, $5);
			$var1 = $1 if $var1 =~ /^\s*"(.*?)"\s*$/;
			$var2 = $1 if $var2 =~ /^\s*"(.*?)"\s*$/;
			if ($paren2 eq ")" && $var2 =~ /^\s*match\s*\((.*?)\s+\)\s*$/i) {
				$var2 = $1;
			} elsif ($paren2 eq ")" && $var2 =~ /^\s*match\s*\((.*?)\s*$/i) {
				$var2 = $1; $paren2 = "";
			} elsif ($var2 =~ m|^\s*\[(.*?)\]\s*$|) {
				$var2 = join("", " _minimath(", dtl_var_replace({}, $1), ") ") if $hash;
				$var2 = join("", " _minimath(", dtl_var_replace($1), ") ") if ! $hash;
			} else {
				$var2 = dtl_var_replace($var2) if ! $hash;
				$var2 = dtl_var_replace({}, $var2) if $hash;
			}
			if ($var1 =~ m%\s*exists:\s*"(.*?)"\s*%) {
				$var1 = join("", " -f ", dtl_var_replace($1));
			} elsif ($var1 =~ m%\s*option_defined:\s*"(.*?)"\s*%) {
				$var1 = join("", " defined \$GLOBAL_OPTIONS->{", dtl_var_replace($1), "} ");
			} elsif ($var1 =~ m|^\s*\[(.*?)\]\s*$|) {
				$var1 = join("", " _minimath(", dtl_var_replace({}, $1), ") ") if $hash;
				$var1 = join("", " _minimath(", dtl_var_replace($1), ") ") if ! $hash;
			} else {
				$var1 = dtl_var_replace($var1) if ! $hash;
				$var1 = dtl_var_replace({}, $var1) if $hash;
			}
			if ($cond =~ /~/) {
				$var2 =~ s/\$(\w+)->\{(\w+)\}/\r\$substitutions->\{$1\}->\{$2\}\r/g;
				if ($cond eq '=~' || $cond eq '!~') {
					my $rexp = "";
					while ($var2 =~ /^(.*)\r(.*?)\r/) {
						$rexp .= quotemeta($1); $rexp .= $2; $var2 = $';
					}
					$rexp .= quotemeta($var2);
					$thisresult = " $var1 $cond /$rexp/i ";
				} else {
					$cond =~ s/^rexp//;
					$var2 =~ s%/%\\/%g;
					$thisresult = " $var1 $cond /$var2/i ";
				}
			} elsif ($cond =~ /^\w+$/) {
				$thisresult .= " $var1 $cond $var2 ";
			} else {
				if ($var2 !~ /\s*join\(/ && $var2 =~ /"(.*?)"/) {
					$thisresult .= " $var1 $cond $1 ";
				} else {
					$thisresult .= " $var1 $cond $var2 ";
				}
			}
			$thisresult = join($thisresult, $paren1, $paren2);
			$thisresult .= $v if $v;
			$result .= $thisresult;
		} elsif ($u =~ /^\s*(\(?)\s*(.*?)\s*(\)?)\s*$/) {
			my ($paren1, $var1, $paren2) = ($1, $2, $3);
			$var1 = $1 if $var1 =~ /^\s*"\s*(.*?)\s*"\s*$/;
			if ($var1 =~ m%\s*exists:\s*"(.*?)"\s*%) {
				$var1 = join("", " -f ", dtl_var_replace($1));
			} elsif ($var1 =~ m%\s*option_defined:\s*"(.*?)"\s*%) {
				$var1 = join("", " defined \$GLOBAL_OPTIONS->{", dtl_var_replace({}, $1), "} ") if $hash;
				$var1 = join("", " defined \$GLOBAL_OPTIONS->{", dtl_var_replace($1), "} ") if ! $hash;
			} elsif ($var1 =~ m|^\s*\[(.*?)\]\s*$|) {
				$var1 = dtl_var_replace({}, $1) if $hash;
				$var1 = dtl_var_replace($1) if ! $hash;
				if ($var1 =~ /^\s*join/) {
					$var1 = " _minimath($var1) ";
				} else {
					$var1 = " _minimath(\"$var1\") ";
				}
			} else {
				$var1 = dtl_var_replace($var1);
			}
			$thisresult .= " $var1 >= 1 ";
			$thisresult = join($thisresult, $paren1, $paren2);
			$thisresult .= $v if $v;
			$result .= $thisresult;
		}
	}
	my $z = join("", "if (", $result, ") {\n");
	return $z;
}

###
### dtl_var_replace
###
### Replaces variables and certain commands
###

sub dtl_var_replace {
	my $K = 0;
	if (ref $_[0] eq 'HASH') {
		$_ = $_[1];
		$K = 1 if /\r/;
	} else {
		$_ = $_[0];
		s%^\s*%% if /\S/;
		s%"%\r!\r%g;
		$K = s%(\$|\{|\}|\\|<#|#>)%\r$1\r%g;
	}
	if (m%(?:\r<#\r|\r\{\r#|<#|\{#)\s*if%i) {
		s%\r!\r%"%g; s%\r(\$|\{|\}|\\|<#|#>)\r%$1%g if $K;
		if (my @z = m%[<\{]#if (.*?)#[>\}]( *)(.*?)( *)[<\{]#else#[>\}]( *)(.*?)( *)[<\{]#endif#[>\}](\s*)%) {
			unshift @z, "";
			my ($before, $after) = ($`, $');
			if ($before =~ /.*[<\{]#[^>\}]*$/ && $after =~ /^[^<\{]*#[>\}]/) {
				template_error("Cannot nest in-line IF-THEN-ELSE within other template language commands", $_);
			}
			my $ifcond = dtl_if_replace($z[1]);
			$ifcond = $1 if $ifcond =~ /\((.*)\)/;
			my $line = "( $ifcond ? join(\"\", ";
			my @out_1 = ();
			push @out_1, "\"$z[2]\"" if $z[2] ne "";
			push @out_1, dtl_var_replace($z[3]) if $z[3] ne "";
			push @out_1, "\"$z[4]\"" if $z[4] ne "";
			$z[8] =~ s/\n/\\n/g;
			push @out_1, "\"$z[8]\"" if $z[8] ne "";
			$line .= join(",", @out_1);
			$line .= ") : join(\"\", ";
			my @out_2 = ();
			push @out_2, "\"$z[5]\"" if $z[5] ne "";
			push @out_2, dtl_var_replace($z[6]) if $z[6] ne "";
			push @out_2, "\"$z[7]\"" if $z[7] ne "";
			push @out_2, "\"$z[8]\"" if $z[8] ne "";
			$line .= join(",", @out_2);
			$line .= "))";
			return join("", "join(\"\", ", dtl_var_replace($before), ", $line, ", dtl_var_replace($after), ")");
		} elsif (my @z = m%[<\{]#if (.*?)#[>\}]( *)(.*?)( *)[<\{]#endif#[>\}](\s*)%) {
			unshift @z, "";
			my ($before, $after) = ($`, $');
			if ($before =~ /.*[<\{]#[^>\}]*$/ && $after =~ /^[^<\{]*#[>\}]/) {
				template_error("Cannot nest in-line IF-THEN-ELSE within other template language commands", $_);
			}
			my $ifcond = dtl_if_replace($z[1]);
			$ifcond = $1 if $ifcond =~ /\((.*)\)/;
			my $line = "( $ifcond ? join(\"\", ";
			my @out_1 = ();
			push @out_1, "\"$z[2]\"" if $z[2] ne "";
			push @out_1, dtl_var_replace($z[3]) if $z[3] ne "";
			push @out_1, "\"$z[4]\"" if $z[4] ne "";
			$z[5] =~ s/\n/\\n/g;
			push @out_1, "\"$z[5]\"" if $z[5] ne "";
			$line .= join(",", @out_1);
			$line .= ") : \"$z[5]\" ";
			$line .= ")";
			return join("", "join(\"\", ", dtl_var_replace($before), ", $line, ", dtl_var_replace($after), ")");
		} elsif (my @z = m%[<\{]#if (.*?)#[>\}]( *)(.*?)( *)\s*$%) {
			unshift @z, "";
			my ($before, $after) = ($`, $');
			if ($before =~ /.*[<\{]#[^>\}]*$/ && $after =~ /^[^<\{]*#[>\}]/) {
				template_error("Cannot nest in-line IF-THEN-ELSE within other template language commands", $_);
			}
			my $ifcond = dtl_if_replace($z[1]);
			$ifcond = $1 if $ifcond =~ /\((.*)\)/;
			my $line = "( $ifcond ? join(\"\", ";
			my @out_1 = ();
			push @out_1, "\"$z[2]\"" if $z[2] ne "";
			push @out_1, dtl_var_replace($z[3]) if $z[3] ne "";
			$z[4] =~ s/\n/\\n/g;
			push @out_1, "\"$z[4]\"" if $z[4] ne "";
			$line .= join(",", @out_1);
			$line .= ", \"\\n\") : \"\" ";
			$line .= ")";
			return join("", "join(\"\", ", dtl_var_replace($before), ", $line)");
		} else {
			template_error("Invalid in-line IF statement", $_);
		}
	} elsif ($K) {
ZLP:	while (m|\r<#\r|) {
			my $flag = 0;
IL1:		while (m%\r<#\rform\s*escape\s*\r!\r(.*?)\r!\r\s*\r#>\r%i) {
				my ($before, $after, $one) = ($`, $', $1);
				if ($one =~ /\r<#\r/) { $flag = 1; last IL1; }
				$_ = join("", $before, "\r\"\r", ", form_escape(", dtl_var_replace({}, $one), "), \r\"\r", $after);
			}
IL2:		while (m%\r<#\rrepeated +(.*?) *\r!\r(.*?)\r!\r\r#>\r%i) {
				my ($before, $after, $one, $two) = ($`, $', $1, $2);
				if ($one =~ /\r<#\r/) { $flag = 1; last IL2; }
				if ($two =~ /\r<#\r/) { $flag = 1; last IL2; }
				$one = dtl_var_replace({}, $one);
				$one = $1 if $one =~ /^"(.*?)"$/;
				$_ = join("", $before, "\r\"\r, ", dtl_var_replace({}, $two), " x ", $one, ", \r\"\r", $after);
			}
IL3:		while (m%\r<#\rescape \r!\r(.*?)\r!\r\r#>\r%i) {
				my ($before, $after, $one) = ($`, $', $1);
				if ($one =~ /\r<#\r/) { $flag = 1; last IL3; }
				$_ = join("", $before, "\r\"\r, escape(", dtl_var_replace({}, $one), "), \r\"\r", $after);
			}
IL4:		while (m%\r<#\runescape \r!\r(.*?)\r!\r\r#>\r%i) {
				my ($before, $after, $one) = ($`, $', $1);
				if ($one =~ /\r<#\r/) { $flag = 1; last IL4; }
				$_ = join("", $before, "\r\"\r, unescape(", dtl_var_replace({}, $one), "), \r\"\r", $after);
			}
IL5:		while (m%\r<#\rremove[_\s]*html \r!\r(.*?)\r!\r\r#>\r%i) {
				my ($before, $after, $one) = ($`, $', $1);
				if ($one =~ /\r<#\r/) { $flag = 1; last IL5; }
				$_ = join("", $before, "\r\"\r, remove_html(", dtl_var_replace({}, $one), "), \r\"\r", $after);
			}
IL6:		while (m%\r<#\rjavascript[ _]prepare \r!\r(.*?)\r!\r\r#>\r%i) {
				my ($before, $after, $one) = ($`, $', $1);
				if ($one =~ /\r<#\r/) { $flag = 1; last IL6; }
				$_ = join("", $before, "\r\"\r, template_js_prepare(", dtl_var_replace({}, $one), "), \r\"\r", $after);
			}
IL7:		while (m%\r<#\rmaxchar\s*(\S+)/(.*?)\s*\r!\r(.*?)\r!\r\r#>\r%i) {
				my ($before, $after, $one, $two, $three) = ($`, $', $1, $2, $3);
				if ($one =~ /\r<#\r/) { $flag = 1; last IL7; }
				if ($two =~ /\r<#\r/) { $flag = 1; last IL7; }
				if ($three =~ /\r<#\r/) { $flag = 1; last IL7; }
				$_ = join("", $before, "\r\"\r, maxcharcut(", dtl_var_replace({}, $one), ",", dtl_var_replace({}, $two), ",", dtl_var_replace({}, $three), "),\r\"\r", $after);
			}
IL8:		while (m%\r<#\rmaxchar\s*(.*?)\s*\r!\r(.*?)\r!\r\r#>\r%i) {
				my ($before, $after, $one, $two) = ($`, $', $1, $2);
				if ($one =~ /\r<#\r/) { $flag = 1; last IL8; }
				if ($two =~ /\r<#\r/) { $flag = 1; last IL8; }
				$_ = join("", $before, "\r\"\r, substrnohtml(", dtl_var_replace({}, $two), ",", dtl_var_replace({}, $one), "),\r\"\r", $after);
			}
IL9:		while (m%\r<#\rpart\s*\r!\r(.*?)\r!\r\s*\((.*?)\)\s*exists\s*\r#>\r%i) {
				my ($before, $after, $one, $two) = ($`, $', $1, $2);
				if ($one =~ /\r<#\r/) { $flag = 1; last IL9; }
				if ($two =~ /\r<#\r/) { $flag = 1; last IL9; }
				$_ = join("", $before, "\r\"\r, does_part_exist(", dtl_var_replace({}, $two), ",", dtl_var_replace({}, $one), "),\r\"\r", $after);
			}
IL10:		while (m%\r<#\rcss\s*size\s*\(([\-\+\d]+)\)\s*\r#>\r%i) {
				my ($before, $after, $one) = ($`, $', $1);
				if ($one =~ /\r<#\r/) { $flag = 1; last IL10; }
				$_ = join("", $before, "\r\"\r, template_css_size(", dtl_var_replace({}, $one), "),\r\"\r", $after);
			}
IL11:		while (m%\r<#\rprogram\s*sub\s*\r!\r(.*?)\r!\r\s*&(\w+)\s*\((.*?)\)\s*\r#>\r%i) {
				my ($before, $after, $one, $two, $three) = ($`, $', $1, $2, $3);
				if ($one =~ /\r<#\r/) { $flag = 1; last IL11; }
				if ($three =~ /\r<#\r/) { $flag = 1; last IL11; }
				$_ = join("", $before, "\r\"\r, program_sub(", dtl_var_replace({}, $one), ", \"$two\", ", dtl_var_replace({}, $three), "),\r\"\r", $after);
			}
IL12:		while (m%\r<#\rwordwrap\s*(\S+)\s*\r!\r(.*?)\r!\r\r#>\r%i) {
				my ($before, $after, $one, $two) = ($`, $', $1, $2);
				if ($one =~ /\r<#\r/) { $flag = 1; last IL12; }
				if ($two =~ /\r<#\r/) { $flag = 1; last IL12; }
				$_ = join("", $before, "\r\"\r, wordwrapper(", dtl_var_replace({}, $one), ", ", dtl_var_replace({}, $two), ", 0),\r\"\r", $after);
			}
IL13:		while (m%\r<#\rwordwrapX\s*(\S+)\s*\r!\r(.*?)\r!\r\r#>\r%i) {
				my ($before, $after, $one, $two) = ($`, $', $1, $2);
				if ($one =~ /\r<#\r/) { $flag = 1; last IL13; }
				if ($two =~ /\r<#\r/) { $flag = 1; last IL13; }
				$_ = join("", $before, "\r\"\r, wordwrapper(", dtl_var_replace({}, $one), ", ", dtl_var_replace({}, $two), ", 1),\r\"\r", $after);
			}
IL14:		while (m%\r<#\rrtpad (\d+) \r!\r(.*?)\r!\r\r#>\r%i) {
				my ($before, $after, $one, $two) = ($`, $', $1, $2);
				if ($two =~ /\r<#\r/) { $flag = 1; last IL14; }
				$_ = join("", $before, "\r\"\r, substr(join(\"\", ", dtl_var_replace({}, $two), ", \" \" x $one), 0, $one),\r\"\r", $after);
			}
IL15:		while (m%\r<#\rstrlength\s*\r!\r(.*?)\r!\r\r#>\r%i) {
				my ($before, $after, $one) = ($`, $', $1);
				if ($one =~ /\r<#\r/) { $flag = 1; last IL15; }
				$_ = join("", $before, "\r\"\r, length(", dtl_var_replace({}, $one), "),\r\"\r", $after);
			}
IL16:		while (m%\r<#\rlength\s*\r!\r(.*?)\r!\r\r#>\r%i) {
				my ($before, $after, $one) = ($`, $', $1);
				if ($one =~ /\r<#\r/) { $flag = 1; last IL16; }
				$_ = join("", $before, "\r\"\r, nohtmllength(", dtl_var_replace({}, $one), "),\r\"\r", $after);
			}
IL17:		while (m%\r<#\r\s*gmtoffset\s*\r#>\r%i) {
				$_ = join("", $`, "\r\"\r, getgmtoffset(), \r\"\r", $');
			}
IL18:		while (m|\r<#\rdate +(.*?) +format\s+\r!\r(.*?)\r!\r\s*\r#>\r|i) {
				my ($datenum, $format, $before, $after) = ($1, $2, $`, $');
				if ($datenum =~ /\r<#\r/) { $flag = 1; last IL18; }
				if ($format =~ /\r<#\r/) { $flag = 1; last IL18; }
				my $one = dtl_var_replace({}, $datenum);
				$_ = join("", $before, "\r\"\r, (", $one, ' =~ /^[0-9]+$/ ? get_date_time(', dtl_var_replace({}, $format), ", ", $one, ") : '&nbsp;'), \r\"\r", $after);
			}
			s%\r<#\rpick\s*(\w+)?\s*(.*?)\s*from\s*\@(\w+)\s*\((.*?)\)\s*\r#>\r%\r\"\r, picker(\r\"\r$1\r\"\r, \r\"\r$2\r\"\r, \r\"\r$3\r\"\r, \r\"\r$4\r\"\r, \$substitutions), \r\"\r%g;
			s%\r<#\rcurrent\s*time\r#>\r%\r"\r, time, \r"\r%g;
			if (m%\r<#\r\s*&\s*(\w+)\s*\(([^\)]*)\s*\)\s*\r#>\r%i) {
				my ($subname, $args, $before, $after) = (lc($1), $2, $`, $');
				template_error("Subroutine $subname not defined prior to being called") if ! defined $PARAMS->{subs}->{$subname};
				my $subr = $PARAMS->{subs}->{$subname};
				my @sa = ();
				$args =~ s/\r!\r/"/g;
				while ($args =~ m|"([^"]*)"\s*,|) {
					$args = $';
					push @sa, dtl_var_replace({}, $1);
				}
				$_ = join("", $before, "\r\"\r, $subr(\$substitutions,", join(",", @sa), "),\r\"\r", $after);
			}
			last ZLP if $flag == 0;
		}
		s%\r\$\r0%\$0%g;
		while (m%\r\$\rL\r(?:->)?\{\r(\w+)\r\}\r\[(.*?)\]%) {
			my ($bef, $var, $arr, $aft) = ($`, $1, $2, $');
			my $z = dtl_var_replace({}, $arr);
			if ($z =~ /^\r\"\r(.*?)\r\"\r/) {
				$z = $1;
			}
			$_ = join("", $bef, "\r\"\r, read_language()->{'$var'}->[", $z, "], \r\"\r", $aft);
		}
		s%\r\{\r\|\r\}\r%\r"\r,\r"\r%g;
		s%\r\$\rL\r(->)?\{\r(\w+)\r\}\r%\r"\r, read_language()->{'$2'}, \r"\r%g;
		s%\r\$\rGLOBAL_OPTIONS(?:->)?\r\{\r(\w+)\r\}\r%\$GLOBAL_OPTIONS->{'$1'}%g;
		s%\r\$\rGLOBAL_OPTIONS(?:->)?\r\{\r\r\$\r(\w+)\r\}\r%\$GLOBAL_OPTIONS->{\$substitutions->{_}->{'$1'}}%g;
		s%\r\$\rENV\r\{\r(\w+)\r\}\r%\$ENV{'$1'}%g;
		s%\r\$\r#(\w+)%\r"\r, ref \$substitutions->{$1} eq 'ARRAY' ? scalar \@{ \$substitutions->{'$1'} } : 0, \r"\r%g;
		s%\r\$\rsubstitutions->\r\{\r(\w+)\r\}\r%\$substitutions->{'$1'}%g;
		s%\r\$\r(\w+)\[\r\$\r(\w+)->\r\{\r(\w+)\r\}\r\]->\r\{\r(\w+)\r\}\r%\r\"\r, \$substitutions->{'$1'}->\[-1\+\(\$substitutions->{'$2'}->{'$3'}\)\]->{'$4'}, \r\"\r%g;
		s%\r\$\r(\w+)\[\r\$\r(\w+)->\r\{\r(\w+)\r\}\r\]%\r"\r, \$substitutions->{'$1'}->\[safe_minus_one(\$substitutions->{'$2'}->{'$3'})\], \r"\r%g;
		s%\r\$\r(\w+)\[(.*?)\]->\r\{\r(\w+)\r\}\r%join("", "\r\"\r, \$substitutions->{'$1'}", "->[safe_minus_one(", dtl_var_replace({}, $2), ")]->{'$3'}", ", \r\"\r")%ge;
		s%\r\$\r(\w+)\[(.*?)\]%join("", "\r\"\r, \$substitutions->{$1}", "->[safe_minus_one(", dtl_var_replace({}, $2), ")] , \r\"\r")%ge;
		s%\r\$\r(\w+)->\r\{\r(\w+)\r\}\r->\r\{\r(\w+)\r\}\r%\$substitutions->{'$1'}->{'$2'}->{'$3'}%g;
		s%\r\$\r(\w+)->\r\{\r(\w+)\r\}\r->\r\{\r\r\$\r(\w+)\r\}\r%\$substitutions->{'$1'}->{'$2'}->{\$substitutions->{_}->{'$3'}}%g;
		s%\r\$\r(\w+)->\r\{\r\r\$\r(\w+)\r\}\r%\$substitutions->{$1}->{\$substitutions->{_}->{'$2'}}%g;
		s%\r\$\r(\w+)->\r\{\r\r\$\r(\w+)->\r\{\r(\w+)\r\}\r\s*?\r\}\r%\$substitutions->{$1}->{\$substitutions->{'$2'}->{'$3'}}%g;
		s%\r\$\r(\w+)->\r\{\r(\w+)\r\}\r%\$substitutions->{'$1'}->{'$2'}%g;
		s%\r\$\r\@(\w+)->\r\{\r(\w+):\s*(\w+)\s*=\s*\r!\r(.*?)\r!\r\r\}\r%join("", "\r\"\r", ", element_array_grep(\$substitutions, \"$3\",", dtl_var_replace({}, $4), ", \"$1\", \"$2\")", ", \r\"\r")%ge;
		s%\r\$\r(\w+)%\$substitutions->{_}->{'$1'}%g;
		s%\r\\\ru%\r^\ru%g;
		s%\r\\\rl%\r^\rl%g;
	} else {
		s/\\/\\\\/g;
		s/\r!\r/\\"/g;
		s/\n/\\n/g;
		s/\r\{\r(\|+)\r\}\r/" " x (length($1)-1)/ge;
		s/\r\{\r(\|)tab(\|)\r\}\r/\\t/g;
		s/\@/\\\@/g;
		s/\r//g;
		template_error( "X", $_ ) if /\{\|+\}/;
		return "\"$_\"";
	}
	if (m%\r\"\r%) {
		s/\\/\\\\/g;
		s/\r!\r/\\"/g;
		s/\r\^\r/\\/g;
		$_ .= " ";
		my @q = split(/\r\"\r/, $_);
		chop $q[$#q];
		foreach my $q7 (@q) {
			$q7 =~ s/\r"\r/\\"/g;
		}
		my $zline = "join(\"\", ";
		my $line = join("", "\"", join("\"", @q));
		$line .= "\")";
		while ($line =~ /\\([ul])"\s*,\s*(\w+)/) {
			my ($before, $after, $one, $case) = ($`, $', $2, $1);
			$before .= "\",";
			my $hold = ""; $after = join("", $one, $after);
			my $counter = 0; my $quoteon = 0;
WX:			while ($after =~ /(.)/) {
				$after = $'; $hold .= $1;
				if ($1 eq "(") {
					$counter += 1 if ! $quoteon;
				} elsif ($1 eq ")") {
					$counter -= 1 if ! $quoteon;
				} elsif ($1 eq "\"") {
					$quoteon = ! $quoteon;
				} elsif ($1 eq "," && ! $quoteon && $counter == 0) {
					$hold =~ s/,$//;
					$line = join("", $before, "case_$case(", $hold, "),", $after);
					last WX;
				}
			}
		}
		$line =~ s/\s*,""\s*\)$/\)/g;
		$line =~ s/^\"\"\s*,\s*//g;
		$line =~ s/\n/\\n/g;
		$line =~ s/\r\{\r(\|+)\r\}\r/" " x (length($1)-1)/ge;
		$line =~ s/\r\{\r(\|)tab(\|)\r\}\r/\\t/g;
		$_ = join("", $zline, $line);
		s/\r//g;
		template_error( "Y", $_ ) if /\{\|+\}/;
		return $_;
	} else {
		s/\\/\\\\/g;
		s/\r!\r/\\"/g;
		s/\r\^\r/\\/g;
		s/\n/\\n/g;
		s/^ *//g;
		s/ *$//g;
		s/\r\{\r(\|+)\r\}\r/" " x (length($1)-1)/ge;
		s/\r\{\r(\|)tab(\|)\r\}\r/\\t/g;
		s/\r//g;
		s/\@/\\\@/g;
		template_error( "Z", $_ ) if /\{\|+\}/;
		return "\"$_\"";
	}
}

1;
