home *** CD-ROM | disk | FTP | other *** search
/ rtsi.com / 2014.01.www.rtsi.com.tar / www.rtsi.com / OS9 / FAQ / discus_admin_1357211388 / source / fcn-val.pl < prev    next >
Text File  |  2009-11-06  |  12KB  |  339 lines
  1. # FILE: fcn-val.pl
  2. # DESCRIPTION: Analyze skins and templates for proper construction
  3. #-------------------------------------------------------------------------------
  4. # DISCUS COPYRIGHT NOTICE
  5. #
  6. # Discus is copyright (c) 2002 by DiscusWare, LLC, all rights reserved.
  7. # The use of Discus is governed by the Discus License Agreement which is
  8. # available from the Discus WWW site at:
  9. #    http://www.discusware.com/discus/license
  10. #
  11. # Pursuant to the Discus License Agreement, this copyright notice may not be
  12. # removed or altered in any way.
  13. #-------------------------------------------------------------------------------
  14.  
  15. use strict;
  16. use vars qw($GLOBAL_OPTIONS $DCONF $PARAMS);
  17.  
  18. ###
  19. ### storage_encode_arguments
  20. ###
  21. ### Encodes subroutine arguments
  22. ###
  23.  
  24. sub template_validator {
  25.     my ($file) = @_;
  26.     my $subst = {};
  27.     my $q = quotemeta($DCONF->{admin_dir}); $file = $' if $file =~ /^$q/;
  28.     $subst->{general}->{filename} = $file;
  29.     my @z = ();
  30.     my $X = readfile($_[0], "template_validator", { no_lock => 1, no_unlock => 1 });
  31.     my @x = @{ $X };
  32.     my $flag = 0;
  33.     my @errs = ();
  34.     my $linecounter = 0;
  35.     my @ifpops = ();
  36.     my $ifcounter = 0;
  37.     my @partpops = ();
  38.     while (my $x = shift @x) {
  39.         $linecounter += 1;
  40.         my $i = {};
  41.         $i->{linenum} = sprintf "%04d", $linecounter;
  42.         $i->{linea} = $linecounter;
  43.         $i->{line} = line_escaper($x);
  44.         $i->{class} = "none";
  45.         push @z, $i;
  46.         if ($flag == 0 && $x !~ /^\s*<!--BEGIN-->\s*$/i) {
  47.             $z[$#z]->{class} = "notconsidered";
  48.             $z[$#z]->{line} = validate_indent_format($z[$#z]->{line}, 0);
  49.             next;
  50.         } elsif ($flag == 1 && $x =~ /^\s*<!--END-->\s*$/i) {
  51.             $flag = 2;
  52.             $z[$#z]->{class} = "beginend";
  53.             $z[$#z]->{line} = validate_indent_format($z[$#z]->{line}, 0);
  54.             next;
  55.         } elsif ($flag == 0 && $x =~ /^\s*<!--BEGIN-->\s*$/i) {
  56.             $flag = 1;
  57.             $z[$#z]->{class} = "beginend";
  58.             $z[$#z]->{line} = validate_indent_format($z[$#z]->{line}, 0);
  59.             next;
  60.         } elsif ($flag == 2) {
  61.             $z[$#z]->{class} = "notconsidered";
  62.             $z[$#z]->{line} = validate_indent_format($z[$#z]->{line}, 0);
  63.             next;
  64.         }            
  65.         if ($x =~ /^\s*#/) {
  66.             $z[$#z]->{class} = "comment";
  67.             $z[$#z]->{line} = validate_indent_format($z[$#z]->{line}, $ifcounter);
  68.             next;
  69.         }
  70.         if ($x =~ m|^\s*<#part "([^"]+)"#>\s*$|i) {
  71.             my $partname = $1;
  72.             if ($#partpops >= 0) {
  73.                 $z[$#z]->{class} = "highlight";
  74.                 my $x = { code => 1, line => $linecounter };
  75.                 $x->{openpart} = $partpops[$#partpops]->{name};
  76.                 $x->{newpart} = $partname;
  77.                 $x->{openline} = $partpops[$#partpops]->{openline};
  78.                 push @errs, $x;
  79.             } elsif (scalar @ifpops) {
  80.                 $z[$#z]->{class} = "highlight";
  81.                 my $x = { code => 2, line => $linecounter };
  82.                 $x->{newpart} = $partname;
  83.                 $x->{lastif} = line_escaper($ifpops[$#ifpops]->{statement});
  84.                 $x->{lastifline} = line_escaper($ifpops[$#ifpops]->{openline});
  85.                 push @errs, $x;
  86.             } else {
  87.                 $ifcounter += 1;
  88.                 push @partpops, {name => $partname, openline => $linecounter };
  89.                 $z[$#z]->{class} = "beginend";
  90.             }
  91.             $z[$#z]->{line} = validate_indent_format($z[$#z]->{line}, 0);
  92.             next;
  93.         }
  94.         if ($x =~ m|^\s*<#/part#>\s*$|i) {
  95.             if ($#partpops >= 0) {
  96.                 if ($ifcounter == 1) {
  97.                     $z[$#z]->{class} = "beginend";
  98.                     $ifcounter -= 1;
  99.                     pop @partpops;
  100.                 } else {
  101.                     $z[$#z]->{class} = "highlight";
  102.                     my $x = { code => 4, line => $linecounter };
  103.                     $x->{lastif} = line_escaper($ifpops[$#ifpops]->{statement});
  104.                     $x->{lastifline} = line_escaper($ifpops[$#ifpops]->{openline});
  105.                     push @errs, $x;
  106.                 }
  107.             } else {
  108.                 $z[$#z]->{class} = "highlight";
  109.                 my $x = { code => 3, line => $linecounter };
  110.                 push @errs, $x;
  111.             }
  112.             $z[$#z]->{line} = validate_indent_format($z[$#z]->{line}, 0);
  113.             next;
  114.         }
  115.         if ($x !~ m|[<\{]#endif#[>\}]|i && $x =~ m|^\s*<#if (.*)#>\s*$|) {
  116.             push @ifpops, { statement => $1, openline => $linecounter };
  117.             $z[$#z]->{line} = validate_indent_format($z[$#z]->{line}, $ifcounter);
  118.             $ifcounter += 1;
  119.             $z[$#z]->{class} = "control";
  120.             next;
  121.         } elsif ($x =~ m|^\s*<#else#>\s*$|i) {
  122.             if (! scalar @ifpops) {
  123.                 $z[$#z]->{class} = "highlight";
  124.                 my $x = { code => 5, line => $linecounter };
  125.                 push @errs, $x;
  126.             } elsif ($ifpops[$#ifpops]->{else} > 0) {
  127.                 $z[$#z]->{class} = "highlight";
  128.                 my $x = { code => 7, line => $linecounter };
  129.                 $x->{lastif} = $ifpops[$#ifpops]->{statement};
  130.                 $x->{lastifline} = $ifpops[$#ifpops]->{openline};
  131.                 $x->{blockelseline} = $ifpops[$#ifpops]->{else};
  132.                 $z[$#z]->{line} = validate_indent_format($z[$#z]->{line}, $ifcounter - 1);
  133.                 push @errs, $x;
  134.                 next;
  135.             } else {
  136.                 $z[$#z]->{class} = "control";
  137.                 $ifpops[$#ifpops]->{else} = $linecounter;
  138.                 $z[$#z]->{line} = validate_indent_format($z[$#z]->{line}, $ifcounter - 1);
  139.                 next;
  140.             }            
  141.             $z[$#z]->{line} = validate_indent_format($z[$#z]->{line}, $ifcounter);
  142.             next;
  143.         } elsif ($x =~ m|^\s*<#endif#>\s*$|i) {
  144.             if (! scalar @ifpops) {
  145.                 $z[$#z]->{class} = "highlight";
  146.                 my $x = { code => 6, line => $linecounter };
  147.                 push @errs, $x;
  148.             } else {
  149.                 $z[$#z]->{class} = "control";
  150.                 $ifcounter -= 1;
  151.                 pop @ifpops;
  152.             }
  153.             $z[$#z]->{line} = validate_indent_format($z[$#z]->{line}, $ifcounter);
  154.             next;
  155.         }
  156.  
  157.         if ($x =~ /[<\{]#/) {
  158.             if ($x =~ m|^(.*)([<\{])#if (.*?)#([>\}])(.*)(\s*)$|) {
  159.                 my @c = ();
  160.                 push @c, validate_template_language($1);
  161.                 push @c, $2;
  162.                 push @c, "#if ";
  163.                 push @c, validate_template_language($3);
  164.                 push @c, "#";
  165.                 push @c, $4;
  166.                 my $after = join("", $5, $6);
  167.                 my ($iftrue, $ifelse, $anyway);
  168.                 if ($after =~ m|(.*)([<\{])#else#([>\}])(.*)([<\{])#endif#([>\}])(.*)(\s*)$|) {
  169.                     push @c, validate_template_language($1);
  170.                     push @c, $2;
  171.                     push @c, "#else#";
  172.                     push @c, $3;
  173.                     push @c, validate_template_language($4);
  174.                     push @c, $5;
  175.                     push @c, "#endif#";
  176.                     push @c, $6;
  177.                     push @c, validate_template_language($7);
  178.                     push @c, $8;
  179.                 } elsif ($after =~ m|(.*)([<\{])#endif#([>\}])(.*)(\s*)$|) {
  180.                     push @c, validate_template_language($1);
  181.                     push @c, $2;
  182.                     push @c, "#endif#";
  183.                     push @c, $3;
  184.                     push @c, validate_template_language($4);
  185.                     push @c, $5;
  186.                 } else {
  187.                     push @c, validate_template_language($after);            
  188.                 }
  189.                 my $line = join("", @c);
  190.                 if ($line =~ /\r/) {
  191.                     push @errs, { code => 8, line => $linecounter };
  192.                     $z[$#z]->{class} = "highlight";
  193.                     
  194.                 }    
  195.                 $z[$#z]->{line} = validate_indent_format(line_escaper($line), $ifcounter);
  196.                 next;
  197.             }
  198.             if ($x =~ m%\s*<#define%) {
  199.                 if ($x =~ m|^\s*<#define\s+\$(\w+)\s*=\s*"?(.*?)"?#>\s*$|i) {
  200.                     my ($one, $two) = ($1, $2);
  201.                     my $q = validate_template_language($two);
  202.                     $q = line_escaper("<#define \$$one = \"$q\"#>");
  203.                     if ($q =~ /\r/) {
  204.                         push @errs, { code => 8, line => $linecounter };
  205.                         $z[$#z]->{class} = "highlight";
  206.                     } else {
  207.                         $z[$#z]->{class} = "define";
  208.                     }
  209.                     $z[$#z]->{line} = validate_indent_format($q, $ifcounter);
  210.                     next;
  211.                 }
  212.             }
  213.             if ($x =~ m|^\s*<#\s*insert\s*(once)?\s*part\s*\((.*?)\)\s*"([^"]+)"\s*\(?(1?)\)?\s*#>\s*$|i) {
  214.                 my $line = join("", "<#insert ", $1 ne "" ? "$1 " : "", "part (", validate_template_language($2), ") \"", validate_template_language($3), "\"", $4 eq "1" ? " (1)" : "", "#>");
  215.                 if ($line =~ /\r/) {
  216.                     push @errs, { code => 8, line => $linecounter };
  217.                     $z[$#z]->{class} = "highlight";
  218.                 } else {
  219.                     $z[$#z]->{class} = "command";
  220.                 }
  221.                 $z[$#z]->{line} = validate_indent_format($line, $ifcounter);
  222.                 next;
  223.             }
  224.  
  225.         }
  226.         my $q = line_escaper(validate_template_language($x));
  227.         if ($q =~ /\r/) {
  228.             $z[$#z]->{class} = "highlight";
  229.             $q =~ s%\r%<img src="$PARAMS->{icon_url}/attention.gif" height=10 width=10>%g;
  230.             push @errs, { code => 8, line => $linecounter };
  231.         }
  232.         $z[$#z]->{line} = validate_indent_format($q, $ifcounter);
  233.     }
  234.     $subst->{lines} = \@z;
  235.     $subst->{errors} = \@errs;
  236.     return $subst;
  237. }
  238.  
  239. sub validate_attention {
  240.     my ($q) = @_;
  241.     $q =~ s%\r%<img src="$PARAMS->{icon_url}/attention.gif" height=10 width=10>%g;
  242.     return $q;    
  243. }
  244.  
  245. sub validate_indent_format {
  246.     my ($text, $indent) = @_;
  247.     $text = validate_attention($text);
  248.     $text =~ s/^\s*//;
  249.     $text = join("", "   " x $indent, $text);
  250.     $text =~ s/\s*$//;
  251.     return $text;    
  252. }
  253.  
  254. sub line_escaper {
  255.     my ($line) = @_;
  256.     $line =~ s/&/&/g;
  257.     $line =~ s/</</g;
  258.     $line =~ s/>/>/g;
  259.     $line =~ s/"/"/g;
  260.     return $line;    
  261. }
  262.  
  263. sub validate_template_language {
  264.     my ($line, $flag) = @_;
  265.     $_ = $line;
  266.     if (! $flag) {
  267.         s%\r\n%\n%g;
  268.         s%\r%\n%g;
  269.         s%"%\r!\r%g;
  270.     }
  271.     my $K = s%(\$|\{|\}|\\|<#|#>)%\r$1\r%g;
  272.     if ($K) {
  273.         if (m|\r<#\r|) {
  274.             $_ = validate_pattern_ok($_, '\r<#\rform\s*escape\s*\r!\r(.*?)\r!\r\s*\r#>\r');
  275.             $_ = validate_pattern_ok($_, '\r<#\rrepeated +(.*?) *\r!\r(.*?)\r!\r\r#>\r');
  276.             $_ = validate_pattern_ok($_, '\r<#\rescape \r!\r(.*?)\r!\r\r#>\r');
  277.             $_ = validate_pattern_ok($_, '\r<#\runescape \r!\r(.*?)\r!\r\r#>\r');
  278.             $_ = validate_pattern_ok($_, '\r<#\rremove[_\s]*html \r!\r(.*?)\r!\r\r#>\r');
  279.             $_ = validate_pattern_ok($_, '\r<#\rjavascript[ _]prepare \r!\r(.*?)\r!\r\r#>\r');
  280.             $_ = validate_pattern_ok($_, '\r<#\rmaxchar\s*(\S+)/(.*?)\s*\r!\r(.*?)\r!\r\r#>\r');
  281.             $_ = validate_pattern_ok($_, '\r<#\rmaxchar\s*(.*?)\s*\r!\r(.*?)\r!\r\r#>\r');
  282.             $_ = validate_pattern_ok($_, '\r<#\rpart\s*\r!\r(.*?)\r!\r\s*\((.*?)\)\s*exists\s*\r#>\r');
  283.             $_ = validate_pattern_ok($_, '\r<#\rcss\s*size\s*\(([\-\+\d]+)\)\s*\r#>\r');
  284.             $_ = validate_pattern_ok($_, '\r<#\rprogram\s*sub\s*\r!\r(.*?)\r!\r\s*&(\w+)\s*\((.*?)\)\s*\r#>\r');
  285.             $_ = validate_pattern_ok($_, '\r<#\rwordwrap\s*(\S+)\s*\r!\r(.*?)\r!\r\r#>\r');
  286.             $_ = validate_pattern_ok($_, '\r<#\rwordwrapX\s*(\S+)\s*\r!\r(.*?)\r!\r\r#>\r');
  287.             $_ = validate_pattern_ok($_, '\r<#\rrtpad (\d+) \r!\r(.*?)\r!\r\r#>\r');
  288.             $_ = validate_pattern_ok($_, '\r<#\rstrlength\s*\r!\r(.*?)\r!\r\r#>\r');
  289.             $_ = validate_pattern_ok($_, '\r<#\rlength\s*\r!\r(.*?)\r!\r\r#>\r');
  290.             $_ = validate_pattern_ok($_, '\r<#\r\s*gmtoffset\s*\r#>\r');
  291.             $_ = validate_pattern_ok($_, '\r<#\rdate +(.*?) +format\s+\r!\r(.*?)\r!\r\s*\r#>\r');
  292.             $_ = validate_pattern_ok($_, '\r<#\rpick\s*(\w+)?\s*(.*?)\s*from\s*\@(\w+)\s*\((.*?)\)\s*\r#>\r');
  293.             $_ = validate_pattern_ok($_, '\r<#\rcurrent\s*time\r#>\r');
  294.             $_ = validate_pattern_ok($_, '\r<#\r\s*&\s*(\w+)\s*\(([^\)]*)\s*\)\s*\r#>\r');
  295.         }
  296.         s%\r\$\r0%\$0%g;
  297.         s%\r\$\rL\r(->)?\{\r(\w+)\r\}\r\[(.*?)\]%\$L$1\{$2\}\[$3\]%g;
  298.         s%\r\{\r(\|+)\r\}\r%\{$1\}%g;
  299.         s%\r\$\rL\r(->)?\{\r(\w+)\r\}\r%\$L$1\{$2\}%g;
  300.         s%\r\$\rGLOBAL_OPTIONS(->)?\r\{\r(\w+)\r\}\r%\$GLOBAL_OPTIONS$1\{$2\}%g;
  301.         s%\r\$\rGLOBAL_OPTIONS(->)?\r\{\r\r\$\r(\w+)\r\}\r%\$GLOBAL_OPTIONS->\{$1\}%g;
  302.         s%\r\$\rENV\r\{\r(\w+)\r\}\r%\$ENV\{$1\}%g;
  303.         s%\r\$\r#(\w+)%\$#$1%g;
  304.         s%\r\$\rsubstitutions->\r\{\r(\w+)\r\}\r%\$substitutions->{$1}%g;
  305.         s%\r\$\r(\w+)\[\r\$\r(\w+)->\r\{\r(\w+)\r\}\r\]->\r\{\r(\w+)\r\}\r%\$$1\[\$$2->\{$3\}\]->\{$4\}%g;
  306.         s%\r\$\r(\w+)\[\r\$\r(\w+)->\r\{\r(\w+)\r\}\r\]%\$$1\[\$$2->\{$3\}\]%g;
  307.         s%\r\$\r(\w+)\[(.*?)\]->\r\{\r(\w+)\r\}\r%\$$1\[$2\]->\{(\w+)\}%g;
  308.         s%\r\$\r(\w+)\[(.*?)\]%\$$1\[$2\]%g;
  309.         s%\r\$\r(\w+)->\r\{\r(\w+)\r\}\r->\r\{\r(\w+)\r\}\r%\$$1->\{$2\}->\{$3\}%g;
  310.         s%\r\$\r(\w+)->\r\{\r(\w+)\r\}\r->\r\{\r\r\$\r(\w+)\r\}\r%\$$1->\{$2\}->\{\$$3\}%g;
  311.         s%\r\$\r(\w+)->\r\{\r\r\$\r(\w+)\r\}\r%\$$1->\{\$$2\}%g;
  312.         s%\r\$\r(\w+)->\r\{\r\r\$\r(\w+)->\r\{\r(\w+)\r\}\r\s*?\r\}\r%\$$1->\{\$$2->\{$3\}\}%g;
  313.         s%\r\$\r(\w+)->\r\{\r(\w+)\r\}\r%\$$1->\{$2\}%g;
  314.         s%\r\$\r\@(\w+)->\r\{\r(\w+):\s*(\w+)\s*=\s*\r!\r(.*?)\r!\r\r\}\r%\$\@$1->\{$2:$3="$4"\}%g;
  315.         s%\r\$\r(\w+)%\$$1%g;
  316.         s%\r\\\ru%\\u%g;
  317.         s%\r\\\rl%\\l%g;
  318.         
  319.         
  320.     }
  321.     s%\r!\r%"%g;
  322.     s%(?:[ \t]|^)\r(\{|\}|\\)\r(?:[ \t]|$)%$1%g;
  323.     s%\r\\\r(\s*)%\\$1%g;
  324.     return $_;    
  325. }
  326.  
  327. sub validate_pattern_ok {
  328.     my ($line, $pattern) = @_;
  329.     while ($line =~ m%$pattern%i) {
  330.         my ($before, $match, $after) = ($`, $&, $');
  331.         $match =~ s/\r!\r/"/g;
  332.         $match =~ s/\r(<#|#>)\r/$1/g;
  333.         $line = join("", $before, $match, $after);
  334.     }    
  335.     return $line;    
  336. }    
  337.  
  338. 1;
  339.