# FILE: fcn-val.pl
# DESCRIPTION: Analyze skins and templates for proper construction
#-------------------------------------------------------------------------------
# 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);

###
### storage_encode_arguments
###
### Encodes subroutine arguments
###

sub template_validator {
	my ($file) = @_;
	my $subst = {};
	my $q = quotemeta($DCONF->{admin_dir}); $file = $' if $file =~ /^$q/;
	$subst->{general}->{filename} = $file;
	my @z = ();
	my $X = readfile($_[0], "template_validator", { no_lock => 1, no_unlock => 1 });
	my @x = @{ $X };
	my $flag = 0;
	my @errs = ();
	my $linecounter = 0;
	my @ifpops = ();
	my $ifcounter = 0;
	my @partpops = ();
	while (my $x = shift @x) {
		$linecounter += 1;
		my $i = {};
		$i->{linenum} = sprintf "%04d", $linecounter;
		$i->{linea} = $linecounter;
		$i->{line} = line_escaper($x);
		$i->{class} = "none";
		push @z, $i;
		if ($flag == 0 && $x !~ /^\s*<!--BEGIN-->\s*$/i) {
			$z[$#z]->{class} = "notconsidered";
			$z[$#z]->{line} = validate_indent_format($z[$#z]->{line}, 0);
			next;
		} elsif ($flag == 1 && $x =~ /^\s*<!--END-->\s*$/i) {
			$flag = 2;
			$z[$#z]->{class} = "beginend";
			$z[$#z]->{line} = validate_indent_format($z[$#z]->{line}, 0);
			next;
		} elsif ($flag == 0 && $x =~ /^\s*<!--BEGIN-->\s*$/i) {
			$flag = 1;
			$z[$#z]->{class} = "beginend";
			$z[$#z]->{line} = validate_indent_format($z[$#z]->{line}, 0);
			next;
		} elsif ($flag == 2) {
			$z[$#z]->{class} = "notconsidered";
			$z[$#z]->{line} = validate_indent_format($z[$#z]->{line}, 0);
			next;
		}			
		if ($x =~ /^\s*#/) {
			$z[$#z]->{class} = "comment";
			$z[$#z]->{line} = validate_indent_format($z[$#z]->{line}, $ifcounter);
			next;
		}
		if ($x =~ m|^\s*<#part "([^"]+)"#>\s*$|i) {
			my $partname = $1;
			if ($#partpops >= 0) {
				$z[$#z]->{class} = "highlight";
				my $x = { code => 1, line => $linecounter };
				$x->{openpart} = $partpops[$#partpops]->{name};
				$x->{newpart} = $partname;
				$x->{openline} = $partpops[$#partpops]->{openline};
				push @errs, $x;
			} elsif (scalar @ifpops) {
				$z[$#z]->{class} = "highlight";
				my $x = { code => 2, line => $linecounter };
				$x->{newpart} = $partname;
				$x->{lastif} = line_escaper($ifpops[$#ifpops]->{statement});
				$x->{lastifline} = line_escaper($ifpops[$#ifpops]->{openline});
				push @errs, $x;
			} else {
				$ifcounter += 1;
				push @partpops, {name => $partname, openline => $linecounter };
				$z[$#z]->{class} = "beginend";
			}
			$z[$#z]->{line} = validate_indent_format($z[$#z]->{line}, 0);
			next;
		}
		if ($x =~ m|^\s*<#/part#>\s*$|i) {
			if ($#partpops >= 0) {
				if ($ifcounter == 1) {
					$z[$#z]->{class} = "beginend";
					$ifcounter -= 1;
					pop @partpops;
				} else {
					$z[$#z]->{class} = "highlight";
					my $x = { code => 4, line => $linecounter };
					$x->{lastif} = line_escaper($ifpops[$#ifpops]->{statement});
					$x->{lastifline} = line_escaper($ifpops[$#ifpops]->{openline});
					push @errs, $x;
				}
			} else {
				$z[$#z]->{class} = "highlight";
				my $x = { code => 3, line => $linecounter };
				push @errs, $x;
			}
			$z[$#z]->{line} = validate_indent_format($z[$#z]->{line}, 0);
			next;
		}
		if ($x !~ m|[<\{]#endif#[>\}]|i && $x =~ m|^\s*<#if (.*)#>\s*$|) {
			push @ifpops, { statement => $1, openline => $linecounter };
			$z[$#z]->{line} = validate_indent_format($z[$#z]->{line}, $ifcounter);
			$ifcounter += 1;
			$z[$#z]->{class} = "control";
			next;
		} elsif ($x =~ m|^\s*<#else#>\s*$|i) {
			if (! scalar @ifpops) {
				$z[$#z]->{class} = "highlight";
				my $x = { code => 5, line => $linecounter };
				push @errs, $x;
			} elsif ($ifpops[$#ifpops]->{else} > 0) {
				$z[$#z]->{class} = "highlight";
				my $x = { code => 7, line => $linecounter };
				$x->{lastif} = $ifpops[$#ifpops]->{statement};
				$x->{lastifline} = $ifpops[$#ifpops]->{openline};
				$x->{blockelseline} = $ifpops[$#ifpops]->{else};
				$z[$#z]->{line} = validate_indent_format($z[$#z]->{line}, $ifcounter - 1);
				push @errs, $x;
				next;
			} else {
				$z[$#z]->{class} = "control";
				$ifpops[$#ifpops]->{else} = $linecounter;
				$z[$#z]->{line} = validate_indent_format($z[$#z]->{line}, $ifcounter - 1);
				next;
			}			
			$z[$#z]->{line} = validate_indent_format($z[$#z]->{line}, $ifcounter);
			next;
		} elsif ($x =~ m|^\s*<#endif#>\s*$|i) {
			if (! scalar @ifpops) {
				$z[$#z]->{class} = "highlight";
				my $x = { code => 6, line => $linecounter };
				push @errs, $x;
			} else {
				$z[$#z]->{class} = "control";
				$ifcounter -= 1;
				pop @ifpops;
			}
			$z[$#z]->{line} = validate_indent_format($z[$#z]->{line}, $ifcounter);
			next;
		}

		if ($x =~ /[<\{]#/) {
			if ($x =~ m|^(.*)([<\{])#if (.*?)#([>\}])(.*)(\s*)$|) {
				my @c = ();
				push @c, validate_template_language($1);
				push @c, $2;
				push @c, "#if ";
				push @c, validate_template_language($3);
				push @c, "#";
				push @c, $4;
				my $after = join("", $5, $6);
				my ($iftrue, $ifelse, $anyway);
				if ($after =~ m|(.*)([<\{])#else#([>\}])(.*)([<\{])#endif#([>\}])(.*)(\s*)$|) {
					push @c, validate_template_language($1);
					push @c, $2;
					push @c, "#else#";
					push @c, $3;
					push @c, validate_template_language($4);
					push @c, $5;
					push @c, "#endif#";
					push @c, $6;
					push @c, validate_template_language($7);
					push @c, $8;
				} elsif ($after =~ m|(.*)([<\{])#endif#([>\}])(.*)(\s*)$|) {
					push @c, validate_template_language($1);
					push @c, $2;
					push @c, "#endif#";
					push @c, $3;
					push @c, validate_template_language($4);
					push @c, $5;
				} else {
					push @c, validate_template_language($after);			
				}
				my $line = join("", @c);
				if ($line =~ /\r/) {
					push @errs, { code => 8, line => $linecounter };
					$z[$#z]->{class} = "highlight";
					
				}	
				$z[$#z]->{line} = validate_indent_format(line_escaper($line), $ifcounter);
				next;
			}
			if ($x =~ m%\s*<#define%) {
				if ($x =~ m|^\s*<#define\s+\$(\w+)\s*=\s*"?(.*?)"?#>\s*$|i) {
					my ($one, $two) = ($1, $2);
					my $q = validate_template_language($two);
					$q = line_escaper("<#define \$$one = \"$q\"#>");
					if ($q =~ /\r/) {
						push @errs, { code => 8, line => $linecounter };
						$z[$#z]->{class} = "highlight";
					} else {
						$z[$#z]->{class} = "define";
					}
					$z[$#z]->{line} = validate_indent_format($q, $ifcounter);
					next;
				}
			}
			if ($x =~ m|^\s*<#\s*insert\s*(once)?\s*part\s*\((.*?)\)\s*"([^"]+)"\s*\(?(1?)\)?\s*#>\s*$|i) {
				my $line = join("", "<#insert ", $1 ne "" ? "$1 " : "", "part (", validate_template_language($2), ") \"", validate_template_language($3), "\"", $4 eq "1" ? " (1)" : "", "#>");
				if ($line =~ /\r/) {
					push @errs, { code => 8, line => $linecounter };
					$z[$#z]->{class} = "highlight";
				} else {
					$z[$#z]->{class} = "command";
				}
				$z[$#z]->{line} = validate_indent_format($line, $ifcounter);
				next;
			}

		}
		my $q = line_escaper(validate_template_language($x));
		if ($q =~ /\r/) {
			$z[$#z]->{class} = "highlight";
			$q =~ s%\r%<img src="$PARAMS->{icon_url}/attention.gif" height=10 width=10>%g;
			push @errs, { code => 8, line => $linecounter };
		}
		$z[$#z]->{line} = validate_indent_format($q, $ifcounter);
	}
	$subst->{lines} = \@z;
	$subst->{errors} = \@errs;
	return $subst;
}

sub validate_attention {
	my ($q) = @_;
	$q =~ s%\r%<img src="$PARAMS->{icon_url}/attention.gif" height=10 width=10>%g;
	return $q;	
}

sub validate_indent_format {
	my ($text, $indent) = @_;
	$text = validate_attention($text);
	$text =~ s/^\s*//;
	$text = join("", "   " x $indent, $text);
	$text =~ s/\s*$//;
	return $text;	
}

sub line_escaper {
	my ($line) = @_;
	$line =~ s/&/&amp;/g;
	$line =~ s/</&lt;/g;
	$line =~ s/>/&gt;/g;
	$line =~ s/"/&quot;/g;
	return $line;	
}

sub validate_template_language {
	my ($line, $flag) = @_;
	$_ = $line;
	if (! $flag) {
		s%\r\n%\n%g;
		s%\r%\n%g;
		s%"%\r!\r%g;
	}
	my $K = s%(\$|\{|\}|\\|<#|#>)%\r$1\r%g;
	if ($K) {
		if (m|\r<#\r|) {
			$_ = validate_pattern_ok($_, '\r<#\rform\s*escape\s*\r!\r(.*?)\r!\r\s*\r#>\r');
			$_ = validate_pattern_ok($_, '\r<#\rrepeated +(.*?) *\r!\r(.*?)\r!\r\r#>\r');
			$_ = validate_pattern_ok($_, '\r<#\rescape \r!\r(.*?)\r!\r\r#>\r');
			$_ = validate_pattern_ok($_, '\r<#\runescape \r!\r(.*?)\r!\r\r#>\r');
			$_ = validate_pattern_ok($_, '\r<#\rremove[_\s]*html \r!\r(.*?)\r!\r\r#>\r');
			$_ = validate_pattern_ok($_, '\r<#\rjavascript[ _]prepare \r!\r(.*?)\r!\r\r#>\r');
			$_ = validate_pattern_ok($_, '\r<#\rmaxchar\s*(\S+)/(.*?)\s*\r!\r(.*?)\r!\r\r#>\r');
			$_ = validate_pattern_ok($_, '\r<#\rmaxchar\s*(.*?)\s*\r!\r(.*?)\r!\r\r#>\r');
			$_ = validate_pattern_ok($_, '\r<#\rpart\s*\r!\r(.*?)\r!\r\s*\((.*?)\)\s*exists\s*\r#>\r');
			$_ = validate_pattern_ok($_, '\r<#\rcss\s*size\s*\(([\-\+\d]+)\)\s*\r#>\r');
			$_ = validate_pattern_ok($_, '\r<#\rprogram\s*sub\s*\r!\r(.*?)\r!\r\s*&(\w+)\s*\((.*?)\)\s*\r#>\r');
			$_ = validate_pattern_ok($_, '\r<#\rwordwrap\s*(\S+)\s*\r!\r(.*?)\r!\r\r#>\r');
			$_ = validate_pattern_ok($_, '\r<#\rwordwrapX\s*(\S+)\s*\r!\r(.*?)\r!\r\r#>\r');
			$_ = validate_pattern_ok($_, '\r<#\rrtpad (\d+) \r!\r(.*?)\r!\r\r#>\r');
			$_ = validate_pattern_ok($_, '\r<#\rstrlength\s*\r!\r(.*?)\r!\r\r#>\r');
			$_ = validate_pattern_ok($_, '\r<#\rlength\s*\r!\r(.*?)\r!\r\r#>\r');
			$_ = validate_pattern_ok($_, '\r<#\r\s*gmtoffset\s*\r#>\r');
			$_ = validate_pattern_ok($_, '\r<#\rdate +(.*?) +format\s+\r!\r(.*?)\r!\r\s*\r#>\r');
			$_ = validate_pattern_ok($_, '\r<#\rpick\s*(\w+)?\s*(.*?)\s*from\s*\@(\w+)\s*\((.*?)\)\s*\r#>\r');
			$_ = validate_pattern_ok($_, '\r<#\rcurrent\s*time\r#>\r');
			$_ = validate_pattern_ok($_, '\r<#\r\s*&\s*(\w+)\s*\(([^\)]*)\s*\)\s*\r#>\r');
		}
		s%\r\$\r0%\$0%g;
		s%\r\$\rL\r(->)?\{\r(\w+)\r\}\r\[(.*?)\]%\$L$1\{$2\}\[$3\]%g;
		s%\r\{\r(\|+)\r\}\r%\{$1\}%g;
		s%\r\$\rL\r(->)?\{\r(\w+)\r\}\r%\$L$1\{$2\}%g;
		s%\r\$\rGLOBAL_OPTIONS(->)?\r\{\r(\w+)\r\}\r%\$GLOBAL_OPTIONS$1\{$2\}%g;
		s%\r\$\rGLOBAL_OPTIONS(->)?\r\{\r\r\$\r(\w+)\r\}\r%\$GLOBAL_OPTIONS->\{$1\}%g;
		s%\r\$\rENV\r\{\r(\w+)\r\}\r%\$ENV\{$1\}%g;
		s%\r\$\r#(\w+)%\$#$1%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%\$$1\[\$$2->\{$3\}\]->\{$4\}%g;
		s%\r\$\r(\w+)\[\r\$\r(\w+)->\r\{\r(\w+)\r\}\r\]%\$$1\[\$$2->\{$3\}\]%g;
		s%\r\$\r(\w+)\[(.*?)\]->\r\{\r(\w+)\r\}\r%\$$1\[$2\]->\{(\w+)\}%g;
		s%\r\$\r(\w+)\[(.*?)\]%\$$1\[$2\]%g;
		s%\r\$\r(\w+)->\r\{\r(\w+)\r\}\r->\r\{\r(\w+)\r\}\r%\$$1->\{$2\}->\{$3\}%g;
		s%\r\$\r(\w+)->\r\{\r(\w+)\r\}\r->\r\{\r\r\$\r(\w+)\r\}\r%\$$1->\{$2\}->\{\$$3\}%g;
		s%\r\$\r(\w+)->\r\{\r\r\$\r(\w+)\r\}\r%\$$1->\{\$$2\}%g;
		s%\r\$\r(\w+)->\r\{\r\r\$\r(\w+)->\r\{\r(\w+)\r\}\r\s*?\r\}\r%\$$1->\{\$$2->\{$3\}\}%g;
		s%\r\$\r(\w+)->\r\{\r(\w+)\r\}\r%\$$1->\{$2\}%g;
		s%\r\$\r\@(\w+)->\r\{\r(\w+):\s*(\w+)\s*=\s*\r!\r(.*?)\r!\r\r\}\r%\$\@$1->\{$2:$3="$4"\}%g;
		s%\r\$\r(\w+)%\$$1%g;
		s%\r\\\ru%\\u%g;
		s%\r\\\rl%\\l%g;
		
		
	}
	s%\r!\r%"%g;
	s%(?:[ \t]|^)\r(\{|\}|\\)\r(?:[ \t]|$)%$1%g;
	s%\r\\\r(\s*)%\\$1%g;
	return $_;	
}

sub validate_pattern_ok {
	my ($line, $pattern) = @_;
	while ($line =~ m%$pattern%i) {
		my ($before, $match, $after) = ($`, $&, $');
		$match =~ s/\r!\r/"/g;
		$match =~ s/\r(<#|#>)\r/$1/g;
		$line = join("", $before, $match, $after);
	}	
	return $line;	
}	

1;
