home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
rtsi.com
/
2014.01.www.rtsi.com.tar
/
www.rtsi.com
/
OS9
/
FAQ
/
cgi-bin
/
discus4_00
/
source
/
fcn-val.pl
< prev
next >
Wrap
Text File
|
2009-11-06
|
12KB
|
339 lines
# 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/&/&/g;
$line =~ s/</</g;
$line =~ s/>/>/g;
$line =~ s/"/"/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;