home *** CD-ROM | disk | FTP | other *** search
/ rtsi.com / 2014.01.www.rtsi.com.tar / www.rtsi.com / OS9 / FAQ / discus_admin_1357211388 / source / template.pl < prev    next >
Text File  |  2009-11-06  |  67KB  |  1,646 lines
  1. # FILE: template.pl
  2. # DESCRIPTION: Template Interpreter
  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. ### page_cacheproc
  20. ###
  21. ### Cache processor for page data
  22. ###
  23.  
  24. sub page_cacheproc {
  25.     my ($topic, $substitutions) = @_;
  26.     $substitutions = hash_merge($substitutions, $PARAMS->{"page_start"}->{$topic});
  27.     my @temp = @{ $PARAMS->{"page_preproc"}->{$topic} };
  28.     my $text = (parse_handle(\@temp, $substitutions, undef, $PARAMS->{"page_ifs"}->{$topic}))[0];
  29.     return $text;
  30. }
  31.  
  32. ###
  33. ### template_makecache
  34. ###
  35. ### Makes a cache for a certain template
  36. ###
  37.  
  38. sub template_makecache {
  39.     my ($subst, $array, $pagetopicflag, $addmessage) = @_;
  40.     my @arr = @{ $array}; 
  41.     my @arr_out = ();
  42.     my $ins_ctr = 0;
  43.     my $topic = 0;
  44.     if (defined $pagetopicflag) {
  45.         $topic = $pagetopicflag;
  46.         foreach my $line (@arr) {
  47.             while ($line =~ m|<#insert\s*(?:once)?\s*part\s*\((.*?)\)\s*"(.*?)"\s*#>|) {
  48.                 $ins_ctr += 1; $line = join("", $`, @{$PARAMS->{"skin,$topic,$2"}}, $');
  49.                 template_error("Recursive insert error (more than 100 inserts in table") if $ins_ctr > 100;
  50.             }
  51.             $ins_ctr = 0;        
  52.         }
  53.     }
  54.     @arr_out = map { join("", $_, "\n") } split(/\n/, join("", @arr));
  55.     @arr_out = grep { ! /^\s*#/ && /\S/ && ! /^\s*<!--(BEGIN|END)-->\s*$/ } @arr_out;
  56.     @arr_out = map { s/^\s*//; s/\s*$//; join("", $_, "\n"); } @arr_out;
  57.     @arr_out = map { s/\s*\#\#.*\s*$/\n/; $_; } @arr_out;
  58.     @arr = ();
  59.     my $ifcounter = 0;
  60.     my @ifarray = ();
  61.     my @ifsubs = ();
  62.     $subst = basic_substitutions($subst);
  63.     $subst = color_substitutions($subst);
  64.     if (defined $pagetopicflag) {
  65.         if (defined $PARAMS->{"skin,$topic,INIT"}) {
  66.             my @temp_params = @{ $PARAMS->{"skin,$topic,INIT"} };
  67.             $subst = (parse_handle(\@temp_params, $subst, 1))[1];
  68.         }
  69.     }
  70.     my $linectr = 0;
  71.     my $indefine = 0;
  72.     my @context = ();
  73.     foreach my $line (@arr_out) {
  74.         $linectr += 1;
  75.         shift @context if scalar @context > 10;
  76.         push @context, $line;
  77.         if ($line =~ m|^\s*<#define\s*array|i) {
  78.             $indefine = 1; next;
  79.         } elsif ($line =~ m|^\s*<#/define|i) {
  80.             $indefine = 0; next;
  81.         } elsif ($indefine == 1) {
  82.             next;
  83.         }
  84.         if ($line !~ m|<#endif#>|i && $line =~ m|^\s*<#if(.*?)#>\s*$|i) {
  85.             $ifcounter += 1; my $zz = $1;
  86.             push @ifarray, { id => $ifcounter, statement => $zz, linecounter => $linectr };
  87.             my $z = makecache_is_true($zz, $addmessage);
  88.             if (defined $z) {
  89.                 push @ifsubs, {condition => $z, sub => sub { return $z; }};
  90.             } else {
  91.                 push @ifsubs, {condition => $zz, sub => sub { return is_true($zz, $_[0]); }};
  92.             }
  93.             $line = "\r%%$ifcounter%%\n";
  94.         } elsif ($line =~ m|^\s*<#else#>\s*$|i) {
  95.             if (! scalar @ifarray) {
  96.                 my $string = "<p>Unmatched <#else#> statement</p><ul>";
  97.                 while ( my $cline  = shift @context) {
  98.                     $cline =~ s/([^\w\s])/join("", "&#", ord($1), ";")/ge;
  99.                     $string .= "<li>$cline\n" if scalar @context;
  100.                     $string .= "<li><font color='#ff0000'>$cline</font>\n" if ! scalar @context;
  101.                 }
  102.                 template_error("$string</ul>");
  103.             }
  104.             $line = "\r%%?$ifarray[$#ifarray]->{id}%%\n";
  105.             $ifarray[$#ifarray]->{else} = $linectr;
  106.         } elsif ($line =~ m|^\s*<#endif#>\s*$|i) {
  107.             if (! scalar @ifarray) {
  108.                 my $string = "<p>Unmatched <#endif#> statement</p><ul>";
  109.                 while ( my $cline  = shift @context) {
  110.                     $cline =~ s/([^\w\s])/join("", "&#", ord($1), ";")/ge;
  111.                     $string .= "<li>$cline\n" if scalar @context;
  112.                     $string .= "<li><font color='#ff0000'>$cline</font>\n" if ! scalar @context;
  113.                 }
  114.                 template_error("$string</ul>");
  115.             }
  116.             $line = "\r%%:$ifarray[$#ifarray]->{id}%%\n";
  117.             my $x = "\r%%$ifarray[$#ifarray]->{id}+";
  118.             $x .= ($ifarray[$#ifarray]->{else} - $ifarray[$#ifarray]->{linecounter}) if defined $ifarray[$#ifarray]->{else};
  119.             $x .= "|";
  120.             $x .= ($linectr - $ifarray[$#ifarray]->{linecounter});
  121.             $x .= "%%\n";
  122.             $arr_out[$ifarray[$#ifarray]->{linecounter}-1] = $x;
  123.             pop @ifarray;
  124.         } elsif ($line =~ m|[<\{]#\s*if(.*?)\s*#[>\}](.*?)[<\{]#else#[>\}](.*?)[<\{]#endif#[>\}]|i) {
  125.             my ($before, $condition, $iftrue, $iffalse, $after) = ($`, $1, $2, $3, $');
  126.             my $z = makecache_is_true($condition, $addmessage);
  127.             if (defined $z) {
  128.                 $line = join("", $before, $iftrue, $after) if $z == 1;
  129.                 $line = join("", $before, $iffalse, $after) if $z == 0;
  130.             } else {
  131.                 $ifcounter += 1;
  132.                 push @ifsubs, {condition => $condition, sub => sub { return is_true($condition, $_[0]); }};
  133.                 $line = join("", $before, "\r%%$ifcounter%%", $iftrue, "\r%%?$ifcounter%%", $iffalse, "\r%%:$ifcounter%%", $after);
  134.             }
  135.         } elsif ($line =~ m|[<\{]#\s*if(.*?)\s*#[>\}](.*?)[<\{]#endif#[>\}]|i) {
  136.             my ($before, $condition, $iftrue, $after) = ($`, $1, $2, $');
  137.             my $z = makecache_is_true($condition, $addmessage);
  138.             if (defined $z) {
  139.                 $line = join("", $before, $iftrue, $after) if $z == 1;
  140.                 $line = join("", $before, $after) if $z == 0;
  141.             } else {
  142.                 $ifcounter += 1;
  143.                 push @ifsubs, {condition => $condition, sub => sub { return is_true($condition, $_[0]); }};
  144.                 $line = join("", $before, "\r%%$ifcounter%%", $iftrue, "\r%%:$ifcounter%%", $after);
  145.             }
  146.         } elsif ($line =~ m|[<\{]#\s*if(.*?)\s*#[>\}]|i) {
  147.             my ($before, $condition, $after) = ($`, $1, $');
  148.             my $z = makecache_is_true($condition, $addmessage);
  149.             if (defined $z) {
  150.                 $line = join("", $before, $after) if $z == 1;
  151.                 $line = join("", $before, "\n") if $z == 0;
  152.             } else {
  153.                 $ifcounter += 1;
  154.                 push @ifsubs, {condition => $condition, sub => sub { return is_true($condition, $_[0]); }};
  155.                 chomp $after;
  156.                 $line = join("", $before, "\r%%$ifcounter%%", $after, "\r%%:$ifcounter%%", "\n");
  157.             }
  158.         }            
  159.             
  160.     }
  161.     if (scalar @ifarray) {
  162.         template_error("Unterminated IF condition <#if $ifarray[$#ifarray]->{statement}#>");
  163.     }
  164.     $PARAMS->{L} = read_language();
  165.     @arr_out = map { s/\$DCONF(?:->)?\{(\w+)\}/$DCONF->{$1}/g; s/\$GLOBAL_OPTIONS(?:->)?\{(\w+)\}/$GLOBAL_OPTIONS->{$1}/g; s/\$L(?:->)?\{(\w+)\}/defined $PARAMS->{L}->{$1} ? $PARAMS->{L}->{$1} : $&/ge; s/\$color->\{(\w+)\}/$subst->{color}->{$1}/g;    if ($topic > 0) { s/\$head->{topic_number}/$topic/g; } $_; } @arr_out;
  166.     return (\@arr_out, $subst, \@ifsubs);
  167. }
  168.  
  169.  
  170. ###
  171. ### page_makecache
  172. ###
  173. ### Makes a cache of the 'page' section for the selected skin
  174. ###
  175.  
  176. sub page_makecache {
  177.     my ($topic, $substitutions) = @_;
  178.     my @arr = @{$PARAMS->{"skin,$topic,page"}};
  179.     $topic = "main" if $topic == 0;
  180.     ($PARAMS->{"page_preproc"}->{$topic}, $PARAMS->{"page_start"}->{$topic}, $PARAMS->{"page_ifs"}->{$topic}) = template_makecache($substitutions, \@arr, $topic, $substitutions->{addmessage});
  181. }
  182.  
  183. ###
  184. ### makecache_is_true
  185. ###
  186. ### Stripped-down processing for cache maker
  187. ###
  188.  
  189. sub makecache_is_true {
  190.     my ($statement, $addmessage) = @_;
  191.     my @condx = ();
  192.     my $y = "==|!=|>|<|>=|<=|eq|ne|gt|ge|lt|le|rexp=~|rexp!~|=~|!~";
  193.     if ($statement =~ m|&&|) {
  194.         @condx = split(/&&/, $statement);
  195.     } elsif ($statement =~ m#\|\|#) {
  196.         @condx = split(/\|\|/, $statement);
  197.     } else {
  198.         @condx = ($statement);
  199.     }
  200.     my $boolean = "or";    $boolean = "and" if $statement =~ m|&&|;
  201.     my $other = 0;
  202.     foreach my $condx (@condx) {
  203.         $condx =~ s/\s+$//;
  204.         $condx =~ s/^\s+//;
  205.         $condx =~ s/\s+/ /g;
  206.         next if $condx eq "";
  207.         if ($condx =~ m|^pro$|i) {
  208.             return 1 if $DCONF->{pro} && $boolean eq "or";
  209.             return 0 if !$DCONF->{pro} && $boolean eq "and";
  210.         } elsif ($condx =~ m|^\!(\s*)pro$|i) {
  211.             return 1 if !$DCONF->{pro} && $boolean eq "or";
  212.             return 0 if $DCONF->{pro} && $boolean eq "and";
  213.         } elsif ($condx =~ m%^\s*\$GLOBAL_OPTIONS(?:->)?\{(\w+)\}$%) {
  214.             my $z = _is_true($GLOBAL_OPTIONS->{$1}, ">=", 1, {}, 1);
  215.             return 1 if $z && $boolean eq "or";
  216.             return 0 if ! $z && $boolean eq "and";
  217.         } elsif ($condx =~ m%^\s*\$GLOBAL_OPTIONS(?:->)?\{(\w+)\}\s*($y)\s*([^\s\$]+)\s*$%o) {
  218.             my $z = _is_true($GLOBAL_OPTIONS->{$1}, $2, $3, {}, 1);
  219.             return 1 if $z && $boolean eq "or";
  220.             return 0 if ! $z && $boolean eq "and";
  221.         } elsif ($condx =~ m%^\s*\$DCONF(?:->)?\{(\w+)\}\s*($y)\s*([^\s\$]+)\s*$%o) {
  222.             my $z = _is_true($DCONF->{$1}, $2, $3, {}, 1);
  223.             return 1 if $z && $boolean eq "or";
  224.             return 0 if ! $z && $boolean eq "and";
  225.         } elsif (ref $addmessage eq "HASH" && $condx =~ m%^\s*\$addmessage->\{(\w+)\}\s*($y)\s*([^\s\$]+)\s*$%o) {
  226.             my $z = _is_true($addmessage->{$1}, $2, $3, {}, 1);
  227.             return 1 if $z && $boolean eq "or";
  228.             return 0 if ! $z && $boolean eq "and";
  229.         } else {
  230.             $other = 1;
  231.         }
  232.     }
  233.     return undef if $other;
  234.     return 1 if $boolean eq "and";
  235.     return 0;
  236. }
  237.  
  238. ###
  239. ### basic_substitutions
  240. ###
  241. ### Sets up basic substitutions
  242. ###
  243.  
  244. sub basic_substitutions {
  245.     my ($substitutions) = @_;
  246.     performance_string("* Initializing basic template variables");
  247.     my @aarray = ();
  248.     for (my $alt_key = 1; $alt_key <= 20; $alt_key += 1) { ## ALT_COLOR_MAX
  249.         $aarray[$alt_key-1]->{'color'} = $GLOBAL_OPTIONS->{"alt_color_$alt_key"};
  250.         $aarray[$alt_key-1]->{'number'} = $alt_key;
  251.     }
  252.     $substitutions->{'_ALTCOLOR'} = \@aarray;
  253.     $substitutions->{'DCONF'} = $DCONF;
  254.     $substitutions->{'PARAMS'} = $PARAMS;
  255.     $substitutions->{'GLOBAL_OPTIONS'} = $GLOBAL_OPTIONS;
  256.     $substitutions->{'browser'}->{'ns4'} = (($ENV{'HTTP_USER_AGENT'} =~ m|4\.(\d+)| && $ENV{'HTTP_USER_AGENT'} !~ m|MSIE|) ? 1 : 0);
  257.     $substitutions->{'browser'}->{'ie4'} = ($ENV{'HTTP_USER_AGENT'} =~ m|MSIE 4\.(\d+)|) ? 1 : 0;
  258.     $substitutions->{'browser'}->{'ie5'} = ($ENV{'HTTP_USER_AGENT'} =~ m|MSIE 5\.(\d+)|) ? 1 : 0;
  259.     $substitutions->{'browser'}->{'ie55'} = ($ENV{'HTTP_USER_AGENT'} =~ m|MSIE 5\.(\d+)| && $1 >= 5) ? 1 : 0;
  260.     $substitutions->{'browser'}->{'ie50'} = $substitutions->{'browser'}->{'ie5'} - $substitutions->{'browser'}->{'ie55'};
  261.     $substitutions->{'browser'}->{'ie6'} = ($ENV{'HTTP_USER_AGENT'} =~ m|MSIE 6\.(\d+)|) ? 1 : 0;
  262.     $substitutions->{'browser'}->{'ns6'} = ($ENV{'HTTP_USER_AGENT'} =~ m|6\.(\d+)| && $ENV{'HTTP_USER_AGENT'} !~ m|MSIE|) ? 1 : 0;
  263.     $substitutions->{'browser'}->{'nsX'} = ($substitutions->{'browser'}->{'ns4'} || $substitutions->{'browser'}->{'ns6'}) ? 1 : 0;
  264.     $substitutions->{'browser'}->{'ieX'} = ($substitutions->{'browser'}->{'ie4'} || $substitutions->{'browser'}->{'ie5'} || $substitutions->{'browser'}->{'ie6'}) ? 1 : 0;
  265.     $substitutions->{'browser'}->{'dhtml'} = ($substitutions->{'browser'}->{'nsX'} || $substitutions->{'browser'}->{'ieX'}) ? 1 : 0;
  266.     $substitutions->{'browser'}->{'mac'} = $ENV{'HTTP_USER_AGENT'} =~ m|Macintosh| ? 1 : 0;
  267.     $substitutions->{'browser'}->{'mozilla'} = $ENV{'HTTP_USER_AGENT'} =~ m|Mozilla/([\d\.]+)| ? $1 : 0;
  268.     $substitutions->{'browser'}->{'webtv'} = $ENV{'HTTP_USER_AGENT'} =~ m|webtv|i ? $1 : 0;
  269.     if ($GLOBAL_OPTIONS->{skinvar_board} || $GLOBAL_OPTIONS->{skinvar_users}) {
  270.         dreq("fcn-info");
  271.         $substitutions = board_info_substitutions($substitutions);
  272.     }    
  273.     $DCONF->{'icon_dir'} = "icons" if $DCONF->{'icon_dir'} eq "";
  274.     $PARAMS->{'icon_url'} = join("/", $DCONF->{html_url}, $DCONF->{icon_dir});
  275.     $PARAMS->{'skin_icon_url'} = join("/", $DCONF->{html_url}, $DCONF->{icon_dir}, $GLOBAL_OPTIONS->{skinchoice});
  276.     $PARAMS->{'skin_icon_dir'} = join("/", $DCONF->{html_dir}, $DCONF->{icon_dir}, $GLOBAL_OPTIONS->{skinchoice});
  277.     $PARAMS->{'topic_file_url'} = $GLOBAL_OPTIONS->{use_static_topic_document} == 1 ? join("/", $DCONF->{message_url}, $DCONF->{board_topics_file}) : join("/", $DCONF->{script_url}, "discus.$DCONF->{cgi_extension}?pg=topics");
  278.     foreach my $k (keys %{$DCONF}) {
  279.         $substitutions->{'_'}->{$k} = $DCONF->{$k} if ref $DCONF->{$k} eq "" && ! defined $substitutions->{'_'}->{$k};
  280.     }
  281.     foreach my $k (keys %{$PARAMS}) {
  282.         $substitutions->{'_'}->{$k} = $PARAMS->{$k} if ref $PARAMS->{$k} eq "" && ! defined $substitutions->{'_'}->{$k};
  283.     }
  284.     return $substitutions;    
  285. }
  286.  
  287. ###
  288. ### color_substitutions
  289. ###
  290. ### Initializes color substitutions
  291. ###
  292.  
  293. sub color_substitutions {
  294.     my ($substitutions) = @_;
  295.     $substitutions->{'color'}->{'bgcolor'} = $GLOBAL_OPTIONS->{'COLOR_bgcolor'} if $GLOBAL_OPTIONS->{'COLOR_bgcolor'} ne "0";
  296.     $substitutions->{'color'}->{'text'} = $GLOBAL_OPTIONS->{'COLOR_text'} if $GLOBAL_OPTIONS->{'COLOR_text'} ne "0";
  297.     $substitutions->{'color'}->{'link'} = $GLOBAL_OPTIONS->{'COLOR_link'} if $GLOBAL_OPTIONS->{'COLOR_link'} ne "0";
  298.     $substitutions->{'color'}->{'vlink'} = $GLOBAL_OPTIONS->{'COLOR_vlink'} if $GLOBAL_OPTIONS->{'COLOR_vlink'} ne "0";
  299.     $substitutions->{'color'}->{'image'} = $GLOBAL_OPTIONS->{'COLOR_image'} if $GLOBAL_OPTIONS->{'COLOR_image'} ne "0";
  300.     $substitutions->{'color'}->{'background'} = $substitutions->{'color'}->{'image'};
  301.     $substitutions->{'color'}->{'alink'} = $GLOBAL_OPTIONS->{'COLOR_alink'} if $GLOBAL_OPTIONS->{'COLOR_alink'} ne "0";
  302.     $substitutions->{'color'}->{'face'} = $GLOBAL_OPTIONS->{'COLOR_face'} if $GLOBAL_OPTIONS->{'COLOR_face'} ne "0";
  303.     $substitutions->{'color'}->{'size'} = $GLOBAL_OPTIONS->{'COLOR_size'} if $GLOBAL_OPTIONS->{'COLOR_size'} ne "0";
  304.     $substitutions->{'color'}->{'smsize'} = $GLOBAL_OPTIONS->{'COLOR_size'} > 1 ? $GLOBAL_OPTIONS->{'COLOR_size'}-1 : 1;
  305.     for (my $alt_key = 1; $alt_key <= 20; $alt_key += 1) { ## ALT_COLOR_MAX
  306.         $substitutions->{'color'}->{"alt_$alt_key"} =
  307.             defined $GLOBAL_OPTIONS->{"alt_color_$alt_key"} ? $GLOBAL_OPTIONS->{"alt_color_$alt_key"} :
  308.             $alt_key == 1 ? "#0000a0" :
  309.             $alt_key <= 10 ? ( $alt_key % 2 == 0 ? "#f7f7f7" : "#d0d0d0" ) : "#000000";
  310.     }
  311.     return $substitutions;
  312. }
  313.  
  314. ###
  315. ### templ_int
  316. ###
  317. ### Controls interpretation of templates.  Modification of this script
  318. ### is strongly discouraged for all but the most advanced of Perl programmers.
  319. ### Modifications should be made in the templates or skins themselves.
  320. ###
  321.  
  322. sub templ_int {
  323.     my ($filename, $substitutions, $cached_file) = @_;
  324.     if ($GLOBAL_OPTIONS->{tcache} == 2) {
  325.         dreq("templnew");
  326.         return (dtl_interpret($filename, $substitutions))[0];        
  327.     }
  328.     if ($filename =~ /^\*(\d*)page$/ && defined $PARAMS->{"page_preproc"}->{$1}) {
  329.         return page_cacheproc($1, $substitutions);
  330.     }
  331.     if (! defined $substitutions->{'_ALTCOLOR'}) {
  332.         $substitutions = basic_substitutions($substitutions);
  333.     }
  334.     if (! defined $substitutions->{'color_override'}) {
  335.         $substitutions = color_substitutions($substitutions);
  336.     }
  337.     my @template = ();
  338.     if (defined $cached_file) {
  339.         @template = @{ $cached_file };
  340.     } elsif ($filename =~ m|^\*(\d*)(.*)|) {
  341.         my ($topic, $partial) = ($1, $2);
  342.         return part_of_skin($topic, $partial, $substitutions);
  343.     } elsif ($filename =~ m|^/|) {
  344.         if (open(TEMPLATE, "< $filename")) {
  345.             @template = <TEMPLATE>;
  346.             close (TEMPLATE);
  347.         } else {
  348.             template_error("Could not read file $filename, so this screen could not be rendered.");
  349.         }
  350.     } elsif ($GLOBAL_OPTIONS->{tcache}) {
  351.         my ($template, $ifarray) = fetch_template_file($filename, undef, 1);
  352.         my @temp = @{ $template };
  353.         performance_string("+ inserting cached template ($filename.tmpl) via templ_int");
  354.         my $text = (parse_handle(\@temp, $substitutions, undef, $ifarray))[0];
  355.         return $text;
  356.     } else {
  357.         @template = @{ fetch_template_file($filename, undef, 0) };
  358.     }
  359.     template_error("Template file [admin_dir]/template/*******/$filename.tmpl is corrupt!  It does not contain the <!--END--> identifier.  Perhaps it was not completely uploaded!") if !grep(m|^\s*<!--END-->\s*$|, @template);
  360.     performance_string("+ inserting template ($filename.tmpl) via templ_int");
  361.     while ($_ = shift(@template)) {
  362.         return (parse_handle(\@template, $substitutions, 1))[0] if m|^\s*<!--BEGIN-->\s*$|;
  363.     }
  364.     template_error("Template file [admin_dir]/template/*******/$filename.tmpl is corrupt!  It does not contain a <!--BEGIN--> identifier!");
  365. }
  366.  
  367. sub fetch_template_file {
  368.     my ($filename, $forcedir, $docache) = @_;
  369.     my @dirs = ('custom', 'pro', 'admin', 'ui', 'mailmesg');
  370. #    @dirs = ($forcedir) if defined $forcedir;
  371.     performance_string("< fetch_template_file for file $filename [force dir: $forcedir]");
  372.     if ($docache) {
  373.         if (! -e "$DCONF->{admin_dir}/data/tcache") {
  374.             mkdir "$DCONF->{admin_dir}/data/tcache", oct($DCONF->{perms0777});
  375.             chmod oct($DCONF->{perms0777}), "$DCONF->{admin_dir}/data/tcache";
  376.         }
  377.         if (-e "$DCONF->{admin_dir}/data/tcache/$filename.cache") {
  378.             my $hash = {}; my @ifarray = ();
  379.             open (FILE, "< $DCONF->{admin_dir}/data/tcache/$filename.cache");
  380.             binmode FILE;
  381.             while (<FILE>) {
  382.                 if (! /\S/) {
  383.                     my @file = <FILE>;
  384.                     close (FILE);
  385.                     performance_string("* returned cached file: ", scalar @file, " lines, ", scalar @ifarray, " conditions");
  386.                     my $ch = quotemeta(chr(12));
  387.                     @file = map { s/$ch\%\%(\W*)(\d+)/\r\%\%$1$2/g; $_; } @file;
  388.                     return (\@file, \@ifarray);
  389.                 }
  390.                 my ($num, $condition) = /^(\d+)\t(.*?)\s*$/;
  391.                 if ($condition =~ /^[01]$/) {
  392.                     $ifarray[$num-1] = { sub => sub { return $condition; }};
  393.                 } else {
  394.                     $ifarray[$num-1] = { sub => sub { return is_true($condition, $_[0]); }};
  395.                 }
  396.             }
  397.             close (FILE);
  398.             template_error("Could not render cached file for $filename.tmpl, so this screen could not be rendered.");
  399.         } else {
  400.             foreach my $dir (@dirs) {
  401.                 if (open(TEMPLATE, "< $DCONF->{admin_dir}/template/$dir/$filename.tmpl")) {
  402.                     my @t = <TEMPLATE>;
  403.                     close (TEMPLATE);
  404. WW:                    while (my $x = shift @t) {
  405.                         last WW if $x =~ /^\s*<!--BEGIN-->\s*$/i;
  406.                     }
  407.                     my ($array, $subst, $ifarray) = template_makecache({}, \@t);
  408.                     my $ch = chr(12);
  409.                     my @array = @{ $array };
  410.                     @array = map { s/\r\%\%(\W*)(\d+)/$ch\%\%$1$2/g; $_; } @array;
  411.                     open (FILE, "> $DCONF->{admin_dir}/data/tcache/$filename.cache");
  412.                     binmode FILE;
  413.                     my $ctr = 0;
  414.                     foreach my $line (@{ $ifarray }) {
  415.                         $ctr++;
  416.                         print FILE "$ctr\t$line->{condition}\n";
  417.                     }
  418.                     print FILE "\n";
  419.                     print FILE @array;
  420.                     close (FILE);                    
  421.                     return ($array, $ifarray);                    
  422.                 }
  423.             }
  424.         }
  425.     } else {
  426.         foreach my $dir (@dirs) {
  427.             if (open(TEMPLATE, "< $DCONF->{admin_dir}/template/$dir/$filename.tmpl")) {
  428.                 my @t = <TEMPLATE>;
  429.                 close (TEMPLATE);
  430.                 return \@t;
  431.             }
  432.         }
  433.     }
  434.     template_error("Could not read file [admin_dir]/template/*******/$filename.tmpl, so this screen could not be rendered.");
  435. }
  436.  
  437. sub part_of_skin {
  438.     my ($topic, $partial, $substitutions, $testflag, $noinit) = @_;
  439.     $PARAMS->{skinlog} = 1;
  440.     if (! defined $PARAMS->{"skin,$topic"}) {
  441.         $PARAMS->{"skin,$topic"} = read_skin($topic);
  442.         if (ref $PARAMS->{"skin,$topic"} eq 'ARRAY') {
  443.             my $flag = "";
  444.             foreach my $line (@{$PARAMS->{"skin,$topic"}}) {
  445.                 if ($line =~ m|^\s*<#part "([^"]+)"#>\s*$|i) {
  446.                     $flag = $1;
  447.                     @{$PARAMS->{"skin,$topic,$flag"}} = ("<!--BEGIN-->\n");
  448.                 } elsif ($line =~ m|^\s*<#/part#>\s*$|i) {
  449.                     push (@{$PARAMS->{"skin,$topic,$flag"}}, "<!--END-->\n");
  450.                     $flag = "";
  451.                 } elsif ($flag ne "") {
  452.                     push (@{$PARAMS->{"skin,$topic,$flag"}}, $line);
  453.                 }
  454.             }
  455.             page_makecache($topic, $substitutions) if $partial eq 'page';
  456.         } else {
  457.             $PARAMS->{"skin,$topic"} = $PARAMS->{"skin,"};
  458.             if ($partial eq 'page') {
  459.                 if (defined $PARAMS->{"page_preproc"}->{main}) {
  460.                     $PARAMS->{"page_preproc"}->{$topic} = $PARAMS->{"page_preproc"}->{main};
  461.                     $PARAMS->{"page_start"}->{$topic} = $PARAMS->{"page_start"}->{main};
  462.                     $PARAMS->{"page_ifs"}->{$topic} = $PARAMS->{"page_ifs"}->{main};
  463.                 } else {
  464.                     page_makecache($topic, $substitutions);
  465.                 }
  466.             }
  467.         }
  468.     }
  469.     my $t = $topic eq "" ? "main" : $topic;
  470.     if ($partial eq 'page' && defined $PARAMS->{"page_preproc"}->{$t}) {
  471.         return page_cacheproc($t, $substitutions);
  472.     }
  473.     if (! $noinit) {
  474.         if (defined $PARAMS->{"skin,$topic,INIT"}) {
  475.             my @temp_params = @{ $PARAMS->{"skin,$topic,INIT"} };
  476.             $substitutions = (parse_handle(\@temp_params, $substitutions, 1))[1];
  477.         }    
  478.     }
  479.     if (defined($PARAMS->{"skin,$topic,$partial"})) {
  480.         return 1 if $testflag;
  481.         my @temp_params = @{ $PARAMS->{"skin,$topic,$partial"} };
  482.         return (parse_handle(\@temp_params, $substitutions, 1))[0];
  483.     } else {
  484.         return 0 if $testflag;
  485.         template_error("Template Request for part [$partial] is not valid.  Skin does not contain this part!");
  486.     }
  487. }
  488.  
  489. sub read_skin {
  490.     my ($topic) = @_;
  491.     my @result = ();
  492.     my $z = $GLOBAL_OPTIONS->{'skinchoice'};
  493.     $GLOBAL_OPTIONS->{'skinchoice'} = $` if $z =~ /\-/ && ! -e "$DCONF->{admin_dir}/skins/$GLOBAL_OPTIONS->{'skinchoice'}.tmpl";
  494.     $GLOBAL_OPTIONS->{'skinchoice'} = "" if ! -e "$DCONF->{admin_dir}/skins/$GLOBAL_OPTIONS->{'skinchoice'}.tmpl";
  495.     $GLOBAL_OPTIONS->{'skinchoice'} = "tables2" if $GLOBAL_OPTIONS->{'skinchoice'} eq "";
  496.     performance_string("< read_skin for topic $topic, skin choice $z");
  497.     if ($topic != 0) {
  498.         if ($DCONF->{"registered_skin_$topic"} ne "") {
  499.             my $filepath = $DCONF->{"registered_skin_$topic"};
  500.             if (open(FILE, "< $filepath")) {
  501.                 @result = <FILE>;
  502.                 close (FILE);
  503.                 return \@result;
  504.             } else {            
  505.                 template_error("Skin Open Error: Could not get skin for topic [$topic]; registered skin $filepath could not be opened ($!)");
  506.             }
  507.         }    
  508.         my $path = get_message_path($topic);
  509.         if (-f "$path/default.tmpl" && -r "$path/default.tmpl") {
  510.             open (FILE, "< $path/default.tmpl");
  511.             @result = <FILE>;
  512.             close (FILE);
  513.             return \@result;
  514.         } elsif (defined $PARAMS->{'skin,'}) {
  515.             performance_string("* read_skin reverting to default");
  516.             my @k = grep { /^skin,,/ } keys %{$PARAMS};
  517.             foreach my $k (@k) {
  518.                 my $parts = (split(/,/, $k, 3))[2];
  519.                 $PARAMS->{"skin,$topic,$parts"} = $PARAMS->{$k};
  520.             }
  521.             return undef;            
  522.         }
  523.     }
  524.     if (open(FILE, "$DCONF->{admin_dir}/skins/$GLOBAL_OPTIONS->{'skinchoice'}.tmpl")) {
  525.         @result = <FILE>;
  526.         close (FILE);
  527.         return \@result;
  528.     } else {
  529.         template_error("Skin Open Error: Could not get skin for topic [$topic] with global skin [$GLOBAL_OPTIONS->{'skinchoice'}]");
  530.     }
  531. }
  532.  
  533. sub debug_handle {
  534.     my ($l) = @_;
  535.     $l =~ s/([^\w\s])/join('', '&#', ord($1), ';')/ge;
  536.     $l =~ s/\s/ /g;
  537.     return $l;
  538. }
  539.  
  540. sub parse_handle {
  541.     my ($arrayref, $substitutions, $original, $ifarray) = @_;
  542.     my $text = ""; my $flag = 0; my $position = 0; my $ifcounter = 0; my $skipper = 0;
  543.     my ($res1, $res2, $res3, $hold, $simple);
  544.     $simple = 0;
  545.     my @ifarray = ();
  546.     @ifarray = @{$ifarray} if ref $ifarray eq 'ARRAY';
  547. WO:    while (my $line = shift (@{$arrayref})) {
  548.         $line =~ s/\r\n/\n/g; ##$line =~ s/\r/\n/g;
  549.         if ($line =~ m|^\s*<!--END-->\s*$|i) {
  550.             return ($text, $substitutions, 0, $skipper);
  551.         }
  552.         next if $line =~ m|^\s*#|;
  553.         next if $line =~ m|^\s*<!--\s*BEGIN\s*-->\s*$|i;
  554.         $line = "$`\n" if $line =~ m|##|;
  555.         $line = $` if $line =~ m|\s*\\\s*$|;
  556.         next if $line !~ m|\S|;
  557.         if ($line =~ /^\s*<#\s*simple\s*variables\s*#>\s*$/i) {
  558.             $simple = 1; next;
  559.         }
  560.         next if $line =~ m|^\s*<#label "?(\w+)"?\s*#>\s*$|i;
  561.         $line =~ s/^\s*<#>/#/;
  562.         if ($flag == $position && $line =~ /\r\%\%\W?(\d+)([\+\|\d]*)\%\%/) {
  563.             my $z = $1; my $cond = $2;
  564.             if ($cond eq "" && $line =~ /\r\%\%(\d+)\%\%(.*)\r\%\%\?\1\%\%(.*)\r\%\%\:\1\%\%/s) {
  565.                 if (ref $ifarray[$z-1]->{sub} ne 'CODE') {
  566.                     template_error(join("", "1) [", ref $ifarray, "] Bad cached 'if' statement for condition #", $z));
  567.                 }
  568.                 my $res = &{ $ifarray[$z-1]->{sub} }($substitutions);
  569.                 $line = join("", $`, $2, $') if $res == 1;
  570.                 $line = join("", $`, $3, $') if $res == 0;
  571.             } elsif ($cond eq "" && $line =~ /\r\%\%(\d+)\%\%(.*)\r\%\%\:\1\%\%/s) {
  572.                 if (ref $ifarray[$z-1]->{sub} ne 'CODE') {
  573.                     template_error(join("", "2) [", ref $ifarray, "] Bad cached 'if' statement for condition #", $z));
  574.                 }
  575.                 my $res = &{ $ifarray[$z-1]->{sub} }($substitutions);
  576.                 $line = join("", $`, $2, $') if $res == 1;
  577.                 $line = join("", $`, $') if $res == 0;
  578.             } elsif ($cond =~ m%^\+(\d*)\|(\d+)$%) {
  579.                 my ($elseoffset, $endifoffset) = ($1, $2);
  580.                 if (ref $ifarray[$z-1]->{sub} ne 'CODE') {
  581.                     template_error(join("", "3) [", ref $ifarray, "] Bad cached 'if' statement for condition #", $z));
  582.                 }
  583.                 my $res = &{ $ifarray[$z-1]->{sub} }($substitutions);
  584.                 if ($res == 1) {
  585.                     if ($elseoffset ne "") {
  586.                         splice @{$arrayref}, $elseoffset-1, 1+$endifoffset-$elseoffset;
  587.                     } else {
  588.                         splice @{$arrayref}, $endifoffset-1, 1;
  589.                     }
  590.                 } else {
  591.                     if ($elseoffset eq "") {
  592.                         splice @{$arrayref}, 0, $endifoffset;
  593.                     } else {
  594.                         splice @{$arrayref}, $endifoffset-1, 1;
  595.                         splice @{$arrayref}, 0, $elseoffset;
  596.                     }                    
  597.                 }
  598.                 next WO;
  599.             }
  600.         }
  601.         if ($line =~ /[<\{]#/) {
  602.             if (!$position && $line !~ m|[<\{]#endif#[>\}]|i && $line =~ m|^\s*<#if (.*)#>\s*$|) {
  603.                 $flag = 2 - is_true($1, $substitutions);
  604.                 $hold = $line; $hold =~ s/</</g; $hold =~ s/>/>/g;
  605.                 $position = 1;
  606.             } elsif ($position && !$ifcounter && $line =~ m|^\s*<#else#>\s*$|) {
  607.                 $position = 2;
  608.             } elsif ($position && !$ifcounter && $line =~ m|^\s*<#endif#>\s*$|) {
  609.                 $position = 0; $flag = 0;
  610.             } elsif (!$position && !$flag && $line =~ m|^\s*<#else#>\s*$|) {
  611.                 unshift(@{$arrayref}, $line);
  612.                 return ($text, $substitutions, 0, $skipper);
  613.             } elsif (!$position && !$flag && $line =~ m|^\s*<#endif#>\s*$|) {
  614.                 unshift(@{$arrayref}, $line);
  615.                 return ($text, $substitutions, 0, $skipper);
  616.             } elsif ($position != $flag && $line !~ m|[<\{]#endif#[>\}]|i && $line =~ m|^\s*<#if (.*)#>\s*$|i) {
  617.                 $ifcounter += 1;
  618.             } elsif ($position != $flag && $line =~ m|^\s*<#endif#>\s*$|) {
  619.                 $ifcounter -= 1;
  620.             } elsif ($flag == $position) {
  621.                 if ($line =~ m|^\s*<#\s*dtl\s*off\s*#>\s*$|i) {
  622. UI:                    while (my $z = shift @{ $arrayref }) {
  623.                         next WO if $z =~ m|^\s*<#\s*dtl\s*on\s*#>\s*$|i;
  624.                         $text .= $z;
  625.                     }
  626.                 } elsif ($line =~ m|^\s*<#\s*perl\s*#>\s*$|i) {
  627.                     while (my $z = shift @{ $arrayref }) {
  628.                         next WO if $z =~ m|^\s*<#\s*/\s*perl\s*#>\s*$|i;
  629.                     }
  630.                     next WO;
  631.                 } elsif ($line =~ m|^\s*<#\s*no\s*perl\s*#>\s*$|i || $line =~ m|^\s*<#\s*/\s*no\s*perl\s*#>\s*$|i) {
  632.                     next WO;                
  633.                 } elsif ($line !~ m|[<\{]#endif#[>\}]|i && $line =~ m|^\s*<#if (.*)#>\s*$|i) {
  634.                     unshift(@{$arrayref}, $line);
  635.                     my ($tb, $sx, $s, $f) = parse_handle($arrayref, $substitutions, 0, $ifarray);
  636.                     $text .= $tb;
  637.                     $substitutions = $sx;
  638.                     if ($f) {
  639.                         $flag = 0; $position = 0; $skipper = 1;
  640.                     }
  641.                     return ($text, $substitutions, $s, $skipper) if $s == 1;
  642.                 } elsif ($line =~ m|^\s*<#foreach\s+\$(\w+)\s+\(\@(\w+)\)#>\s*$|i) {
  643.                     my $z = "";
  644.                     if (!defined($substitutions->{$2})) {
  645.                         my $a = $2; my $st = $line;    $st =~ s/([^\w\s])/join("", "&#", ord($1), ";")/ge;
  646.                         template_error("Undefined array \@$a in 'foreach' statement '$st' in this template.");
  647.                     } else {
  648.                         $z = process_foreach($arrayref, $1, $2, $substitutions, $ifarray);
  649.                         $text .= $z;
  650.                     }
  651.                 } elsif ($line =~ m|^\s*<#for\s+\$(\w+)\s*=\s*(.*?)\s+to\s+(.*?)\s+step\s+(.*?)\s*#>\s*$|i) {
  652.                     my $z = process_for($arrayref, $1, $2, $3, $4, $substitutions, $ifarray);
  653.                     $text .= $z;
  654.                 } elsif ($line =~ m|^\s*<#define|) {
  655.                     if ($line =~ m|^\s*<#define\s+\$(\w+)\s*=\s*"?(.*?)"?#>\s*$|i) {
  656.                         $substitutions->{"_"}->{$1} = substitutions($2, $substitutions, $simple, $ifarray);
  657.                     } elsif ($line =~ m|^\s*<#define\s+\$(\w+)\s*\[\s*(.*?)\s*\]\s*=\s*"?(.*?)"?#>\s*$|i) {
  658.                         next if substitutions($2, $substitutions, $simple, $ifarray) <= 0;
  659.                         $substitutions->{$1}[-1+substitutions($2, $substitutions, $simple, $ifarray)] = substitutions($3, $substitutions, $simple, $ifarray);
  660.                     } elsif ($line =~ m|^\s*<#define\s*array\s*\@(\w+)\s*\(([\w\s,]+)\)\s*#>\s*$|i) {
  661.                         $substitutions = process_define_array($1, $2, $substitutions, $arrayref);
  662.                     } elsif ($line =~ m|^\s*<#define\s*\$GLOBAL_OPTIONS(?:->)?\{(\w+)\}\s*=\s*"?(.*?)"?\s*#>\s*$|i) {
  663.                         next if $GLOBAL_OPTIONS->{skinvar_override_option} == 0;
  664.                         $GLOBAL_OPTIONS->{$1} = substitutions($2, $substitutions, $simple, $ifarray);
  665.                     } else {
  666.                         $line =~ s/([^\w\s])/join(ord($1), "&#", ";")/ge;
  667.                         template_error("Bad <#define#> statement in template file... This line was: $line");
  668.                     }                
  669.                 } elsif ($line =~ m|^\s*<#mathdefine:?\s*\$(\w+)\s*=\s*(.*?)\s*#>\s*$|i) {
  670.                     $substitutions->{"_"}->{$1} = mathdefine(substitutions($2, $substitutions, $simple, $ifarray));            
  671.                 } elsif ($line =~ m|^\s*<#language\s*:\s*\$L(?:->)?\{(\w+)\}\s*=?\s*"(.*?)"\s*#>\s*$|i) {
  672.                     $PARAMS->{L} = read_language();
  673.                     if (! defined $PARAMS->{L}->{$1}) {
  674.                         $PARAMS->{L}->{$1} = substitutions($2, $substitutions, $simple, $ifarray);
  675.                     }                
  676.                 } elsif ($line =~ m|^\s*<#key\s+replace\s*\$(\w+)\s*"(.*?)"\s*[-=]\s*>\s*"(.*?)"\s*#>|i) {
  677.                     $substitutions->{$1}->{$3} = $substitutions->{$1}->{$2};
  678.                 } elsif ($line =~ m|^\s*<#skipto\s*"?(\w+)"?#>\s*$|i) {
  679.                     my $one = $1;
  680.                     $flag = 0; $position = 0; $skipper = 1; my $sc = 0;
  681. WI:                    while (my $sh = shift(@{$arrayref})) {
  682.                         $sc += 1;
  683.                         next WO if $sh =~ m|^\s*<#label\s*"?$one\s*"?#>\s*$|i;
  684.                     }
  685.                     template_error("Bad label <b>$one</b> called by SKIPTO directive.");
  686.                 } elsif ($line =~ m|^\s*<#sub \s*(.*)\s*#>\s*$|i) {
  687.                     $substitutions = declare_sub($arrayref, $1, $substitutions, $ifarray);
  688.                 } elsif ($line =~ m|^\s*<#while\s*\((.*)\)\s*#>\s*$|i) {
  689.                     my ($tb, $sb) = process_while($arrayref, $1, $substitutions, $ifarray);
  690.                     $text .= $tb;
  691.                     $substitutions = $sb;
  692.                 } elsif ($line =~ m|^\s*<#math:\s*(.*?)\s*#>\s*$|i) {
  693.                     $substitutions = process_math($1, $substitutions);
  694.                 } elsif ($line =~ m|^\s*<#\s*replace\s*"(.*?)"\s*with\s*"(.*?)"\s*in\s*\$(.*?)\s*#>\s*$|i) {
  695.                     my ($oldpattern, $newpattern, $variablename) = ($1, $2, $3);
  696.                     my $q = quotemeta($oldpattern); my $n = substitutions($newpattern, $substitutions, $simple, $ifarray);
  697.                     $substitutions->{"_"}->{$variablename} =~ s/$q/$n/gi;
  698.                 } elsif ($line =~ m|^\s*<#reference\s*array\s*\@(\w+)\s+from\s*(.*?)\s*except\s*(.*?)\s*=\s*\((.*?)\)\s*#>\s*$|i) {
  699.                     my ($arrayname, $arrayfrom, $field, $except) = ($1, $2, $3, $4);
  700.                     my %e = map { trim($_), 1 } split(/,/, trim($except));
  701.                     $field = trim($field);
  702.                     my $tgt = undef;
  703.                     $tgt = $substitutions->{$1}->{$2} if $arrayfrom =~ m|\$(\w+)->\{(\w+)\}|;
  704.                     my @z = ();
  705.                     if (ref $tgt eq 'ARRAY') {
  706.                         @z = grep ($e{$_->{$field}} == 0, @{$tgt});
  707.                     }
  708.                     $substitutions->{$arrayname} = \@z;
  709.                 } elsif ($line =~ m|^\s*<#reference\s*array\s*\@(\w+)\s+from\s*(.*?)\s*#>\s*$|i) {
  710.                     my ($arrayname, $arrayfrom) = ($1, $2);
  711.                     my $tgt = undef;
  712.                     $tgt = $substitutions->{$1}->{$2} if $arrayfrom =~ m|\$(\w+)->\{(\w+)\}|;
  713.                     if (ref $tgt ne 'ARRAY') {
  714.                         my @empty = ();
  715.                         $tgt = \@empty;
  716.                     }
  717.                     $substitutions->{$arrayname} = $tgt;
  718.                 } elsif ($line =~ m|^\s*<#exit#>\s*$|i) {
  719.                     $flag = 0;
  720.                     return ($text, $substitutions, 1, $skipper);
  721.                 } else {
  722.                     my $u = process_line($line, $substitutions, $simple, $ifarray);
  723.                     $text .= $u;
  724.                 }
  725.             }
  726.         } elsif ($flag == $position) {
  727.             my $u = process_line($line, $substitutions, $simple, $ifarray);
  728.             $text .= $u;
  729.         }
  730.     }
  731.     if ($flag) {
  732.         template_error("Unterminated IF condition in template file... make sure IF statements are closed with <#endif#>!  Last line was: [$hold].");
  733.     }
  734.     return ($text, $substitutions, 0, $skipper);
  735. }
  736.  
  737. sub mathdefine {
  738.     my ($text) = @_;
  739.     while ($text =~ /(\w+)\(/) {
  740.         my ($before, $match, $after) = ($`, $1, $');
  741.         $after = mathdefine($after);
  742.         if ($after !~ /([^\)]+)\)/) {
  743.             template_error("Bad Math Definition: $before $match $after (no closing paren)");
  744.         }
  745.         my ($after1, $after2) = ($1, $');
  746.         if ($match =~ /^int$/i) {
  747.             $after1 = int($after1);
  748.         } else {
  749.             my @x = split(/,/, $after1);
  750.             my $ct = trim(shift @x);
  751.             while (my $u = shift @x) {
  752.                 $u = trim($u);
  753.                 $ct += $u if ($match =~ /^sum$/i || $match =~ /^plus$/i);    
  754.                 $ct -= $u if ($match =~ /^diff$/i || $match =~ /^minus$/i);    
  755.                 $ct *= $u if ($match =~ /^prod$/i || $match =~ /^product$/ || $match =~ /^times$/i);    
  756.                 $ct /= $u if $u != 0 && ($match =~ /^quot$/i || $match =~ /^quotient$/ || $match =~ /^divide$/i);    
  757.                 $ct %= $u if $u != 0 && ($match =~ /^mod$/i || $match =~ /^modulus$/);    
  758.                 $ct **= $u if ($match =~ /^raise$/i);    
  759.             }
  760.             $after1 = $ct;            
  761.         }
  762.         $text = join("", $before, $after1, $after2);        
  763.     }
  764.     return $text;
  765. }
  766.  
  767. sub process_while {
  768.     my ($arrayref, $input, $substitutions, $ifarray) = @_;
  769.     undef my @inwhile;
  770.     my $whilecounter = 0;
  771.     undef my $text;
  772. O:    while (my $y = shift(@{ $arrayref })) {
  773.         if ($y =~ m|^\s*<#/while#>\s*$|i) {
  774.             $input =~ s/^\s+//;
  775.             $input =~ s/\s+$//;
  776. inner:        while (is_true($input, $substitutions)) {
  777.                 my @inwhile_copy = @inwhile;
  778.                 $whilecounter += 1;
  779.                 my ($textback, $sx, $s) = parse_handle(\@inwhile_copy, $substitutions, undef, $ifarray);
  780.                 $substitutions = $sx;
  781.                 if ($textback =~ m|\r?<#\r?last\r?#>\r?|i || $textback =~ m|\r?<#\r?break\r?#>\r?|i) {
  782.                     $textback = $`;
  783.                     $text .= $textback;
  784.                     last inner;
  785.                 }
  786.                 $text .= $textback;
  787.                 if ($whilecounter > 5000) {
  788.                     template_error("While reached 5000 iterations.  Suspect never-ending loop!  Statement [$input].");
  789.                 }
  790.             }
  791.             return ($text, $substitutions);
  792.         } elsif ($y =~ m|^\s*<#while\s*\((.*)\)\s*#>\s*$|i) {
  793.             my ($st, $sx) = process_while($arrayref, $1, $substitutions, $ifarray);
  794.             $substitutions = $sx;
  795.             push (@inwhile, $st);
  796.         } else {
  797.             push (@inwhile, $y);
  798.         }
  799.     }
  800.     template_error("While condition [$input] not terminated!");
  801. }
  802.  
  803. sub declare_sub {
  804.     my ($arrayref, $input, $substitutions, $ifarray) = @_;
  805.     template_error("Invalid Subroutine declaration for [$input]!") if $input !~ m|^(\w+)\s*\(([\s\$\w\,]*)\)\s*$|;
  806.     my $subname = $1;
  807.     my $subarg = $2;
  808.     if (defined $substitutions->{"_subs"}->{$subname}) {
  809.         while (my $line = shift(@{$arrayref})) {
  810.             return $substitutions if $line =~ m|^\s*<#\s*end\s*sub\s*#>\s*$|i;
  811.         }
  812.         return $substitutions;
  813.     }
  814.     $subarg =~ s/\s//g;
  815.     my @subarg = split(/,/, $subarg);
  816.     $substitutions->{"_subs"}->{$subname}->{args} = \@subarg;
  817.     while (my $line = shift(@{$arrayref})) {
  818.         return $substitutions if $line =~ m|^\s*<#\s*end\s*sub\s*#>\s*$|i;
  819.         push(@{ $substitutions->{"_subs"}->{$subname}->{code} }, $line);
  820.     }
  821.     template_error("Subroutine [$subname] not ended with <#end sub#> tag!");
  822. }
  823.  
  824. sub process_math {
  825.     my ($operation, $substitutions) = @_;
  826.     my $text = "";
  827.     my ($value1, $op, $value2) = split(/\s+/, $operation);
  828.     $value1 = $1 if $value1 =~ m|^"(.*)"$|;
  829.     $value2 = $1 if $value2 =~ m|^"(.*)"$|;
  830.     my $value1_temp = substitutions($value1, $substitutions);
  831.     $value2 = substitutions($value2, $substitutions);
  832.     $value1_temp += $value2 if $op eq "+=";
  833.     $value1_temp -= $value2 if $op eq "-=";
  834.     $value1_temp *= $value2 if $op eq "*=";
  835.     $value1_temp /= $value2 if $value2 != 0 && $op eq "/=";
  836.     $value1_temp %= $value2 if $value2 != 0 && $op eq "%=";
  837.     $substitutions->{$1}->{$2} = $value1_temp if $value1 =~ m|^\$(\w+)->\{(\w+)\}$|;
  838.     $substitutions->{_}->{$1} = $value1_temp if $value1 =~ m|^\$(\w+)$|;
  839.     return $substitutions;
  840. }
  841.  
  842. sub process_define_array {
  843.     my ($arrayname, $fieldnames, $substitutions, $arrayref) = @_;
  844.     if (defined($substitutions->{$arrayname})) {
  845.         $substitutions->{$arrayname} = undef;
  846.     }
  847.     $fieldnames =~ s/\s//g;
  848.     my @fieldnames = split(/,/, $fieldnames);
  849.     undef my @array;
  850.     &template_error("Array \@$arrayname does not have any field names defined!") if scalar(@fieldnames) < 1;
  851.     while (my $line = shift(@{$arrayref})) {
  852.         if ($line =~ m|^\s*<#/define#>\s*$|i) {
  853.             $substitutions->{$arrayname} = \@array;
  854.             return $substitutions;
  855.         }
  856.         if ($line =~ m|^\s*<#define|) {
  857.             template_error("Cannot nest definitions in defining \@$arrayname!");
  858.         }
  859.         if ($line =~ m|^\s*<#if([^>]+)#>\s*$|i || $line =~ m|^\s*<#else#>\s*$| || $line =~ m|^\s*<#endif#>\s*$|i) {
  860.             template_error("Block IF-THEN-ELSE statements not permitted within array definitions, in defining \@$arrayname!");
  861.         }
  862.         if ($line =~ m|^\s*<#foreach\s*|i || $line =~ m|^\s*<#endloop#>\s*$|i) {
  863.             template_error("FOREACH statements not permitted within array definitions, in defining \@$arrayname!");
  864.         }
  865.         if ($line =~ m|^\s*<#for\s*|i || $line =~ m|^\s*<#endfor#>\s*$|i) {
  866.             template_error("FOR statements not permitted within array definitions, in defining \@$arrayname!");
  867.         }
  868.         chomp $line;
  869.         my @linesplits = split(/\t/, $line);
  870.         undef my $hashref;
  871.         if ($linesplits[0] =~ m|^\s*<#if\s+(.*?)#>\s*$|i) {
  872.             next if ! is_true($1, $substitutions);
  873.             shift (@linesplits);
  874.         }
  875.         foreach my $key (@fieldnames) {
  876.             $hashref->{$key} = &process_line(shift(@linesplits), $substitutions);
  877.             $hashref->{$key} =~ s/\s+$//;
  878.         }
  879.         if (defined($hashref->{'_index'})) {
  880.             &template_error("Invalid index $hashref->{_index} for array definition \@$arrayname!") if $hashref->{_index} < 1;
  881.             $array[ $hashref->{'_index'} - 1 ] = $hashref;
  882.         } else {
  883.             push (@array, $hashref);
  884.         }
  885.     }
  886.     template_error("Array \@$arrayname does not have an ending tag for the definition!");
  887. }
  888.  
  889. sub process_for {
  890.     my ($arrayref, $variable, $lower, $upper, $step, $substitutions, $ifarray) = @_;
  891.     $lower = 0 + substitutions($lower, $substitutions, undef, $ifarray);
  892.     $upper = 0 + substitutions($upper, $substitutions, undef, $ifarray);
  893.     $step = 0 + substitutions($step, $substitutions, undef, $ifarray);
  894.     my $nest_counter = 0;
  895.     my @array = ();
  896.     while (my $line = shift @{ $arrayref }) {
  897.         if ($line =~ m|^\s*<#for (.*)#>\s*$|i) {
  898.             $nest_counter += 1;
  899.             push @array, $line;
  900.         } elsif ($nest_counter > 0 && $line =~ m|^\s*<#endfor#>\s*$|i) {
  901.             $nest_counter -= 1;
  902.             push @array, $line;
  903.         } elsif ($line =~ m|^\s*<#endfor#>\s*$|i) {
  904.             template_error("Step cannot be zero") if $step == 0;
  905.             my @tarr = ();
  906.             if ($upper >= $lower) {
  907.                 $step = -1*$step if $step < 0;
  908.                 for (my $i = $lower; $i <= $upper; $i += $step) {
  909.                     push @tarr, $i;
  910.                 }
  911.             } else {
  912.                 $step = -1*$step if $step < 0;
  913.                 for (my $i = $upper; $i >= $lower; $i += $step) {
  914.                     push @tarr, $i;
  915.                 }
  916.             }
  917.             return "" if scalar(@tarr) == 0;
  918.             my $text = "";
  919.             my $temp_subst = $substitutions;
  920.             my $counter = 1;
  921.             foreach my $i (@tarr) {
  922.                 my @array_copy = @array;
  923.                 $temp_subst->{"_"}->{$variable} = $i;
  924.                 $temp_subst->{$variable}->{value} = $i;
  925.                 $temp_subst->{$variable}->{_internal_counter} = $counter - 1;
  926.                 $temp_subst->{$variable}->{'_iteration'} = $counter;
  927.                 $temp_subst->{$variable}->{'_iteration_minus1'} = ($counter - 1);
  928.                 $temp_subst->{$variable}->{'_is_last_element'} = $counter == scalar(@tarr) ? 1 : 0;
  929.                 $temp_subst->{$variable}->{'_is_first_element'} = $counter == 1 ? 1 : 0;
  930.                 $counter++;
  931.                 my $textback = (parse_handle(\@array_copy, $temp_subst, undef, $ifarray))[0];
  932.                 $textback = $` if $textback =~ m|\r?<#\r?next\r?#>\r?|i;
  933.                 if ($textback =~ m|\r?<#\r?last\r?#>\r?|i) {
  934.                     return join("", $text, $`);
  935.                 }
  936.                 $text .= $textback;                
  937.             }
  938.             return $text;
  939.         } else {
  940.             push (@array, $line);
  941.         }
  942.     }
  943.     template_error("Unterminated FOR (\$$variable) loop in template file... make sure FOR statements are closed with <#endfor#>!");
  944. }
  945.  
  946. sub process_foreach {
  947.     my ($arrayref, $variable, $array, $substitutions, $ifarray) = @_;
  948.     my $text = "";
  949.     my @array = ();
  950.     my $nest_counter = 0;
  951.     while (my $line = shift(@{$arrayref})) {
  952.         if ($line =~ m|^\s*<#foreach(.*)#>\s*$|i) {
  953.             $nest_counter += 1;
  954.             push (@array, $line);
  955.         } elsif ($nest_counter > 0 && $line =~ m|^\s*<#endloop#>\s*$|i) {
  956.             $nest_counter -= 1;
  957.             push (@array, $line);
  958.         } elsif ($line =~ m|^\s*<#endloop#>\s*$|i) {
  959.             my @temp_arr = @{ $substitutions->{$array} };
  960.             my $counter = 1;
  961.             my $internal_counter = 0;
  962.             foreach my $key (@temp_arr) {
  963.                 $internal_counter += 1;
  964.                 my $temp_subst = $substitutions;
  965.                 $temp_subst->{$variable} = $key;
  966.                 $temp_subst->{$variable}->{'_internal_counter'} = $internal_counter;
  967.                 $temp_subst->{$variable}->{'_iteration'} = $counter;
  968.                 $temp_subst->{$variable}->{'_iteration_minus1'} = $counter-1;
  969.                 $temp_subst->{$variable}->{'_is_last_element'} = $internal_counter == scalar(@temp_arr) ? 1 : 0;
  970.                 $temp_subst->{$variable}->{'_is_first_element'} = $internal_counter == 1 ? 1 : 0;
  971.                 $temp_subst->{$variable}->{'_previous_element'} = $counter == 1 ? $temp_arr[0] : $temp_arr[$counter-2];
  972.                 $temp_subst->{$variable}->{'_next_element'} = $counter == scalar(@temp_arr) ? $temp_arr[$#temp_arr] : $temp_arr[$counter];
  973.                 my @array_copy = @array;
  974.                 my $textback = (parse_handle(\@array_copy, $temp_subst, undef, $ifarray))[0];
  975.                 $textback = $` if $textback =~ m|\r?<#\r?next\r?#>\r?|i;
  976.                 if ($textback =~ m|\r?<#\r?last\r?#>\r?|i) {
  977.                     $textback = $`;
  978.                     return join("", $text, $textback);
  979.                 }
  980.                 if ($textback =~ m|<#skip\s*iteration#>|i) {
  981.                     while ($textback =~ m|<#skip\s*iteration#>|i) {
  982.                         $textback = join("", $`, $');
  983.                     }
  984.                 } else {
  985.                     $counter += 1;
  986.                 }
  987.                 $text .= $textback;
  988.             }
  989.             return $text;
  990.         } else {
  991.             push (@array, $line);
  992.         }
  993.     }
  994.     template_error("Unterminated FOREACH (\$$variable \@$array) loop in template file... make sure FOREACH statements are closed with <#endloop#>!");
  995. }
  996.  
  997. sub process_line {
  998.     my ($line, $substitutions, $simple, $ifarray) = @_;
  999.     if ($line =~ /[<\{]#/) {
  1000.         if ($line =~ m|^(.*)[<\{]#if (.*?)#[>\}](.*)(\s*)$|) {
  1001.             my ($before, $condition, $after) = ($1, $2, join("", $3, $4));
  1002.             my ($iftrue, $ifelse, $anyway);
  1003.             if ($after =~ m|(.*)[<\{]#else#[>\}](.*)[<\{]#endif#[>\}](.*)(\s*)$|) {
  1004.                 ($iftrue, $ifelse, $anyway) = ($1, $2, join("", $3, $4));
  1005.             } elsif ($after =~ m|(.*)[<\{]#endif#[>\}](.*)(\s*)$|) {
  1006.                 ($iftrue, $ifelse, $anyway) = ($1, "", join("", $2, $3));
  1007.             } else {
  1008.                 ($iftrue, $ifelse, $anyway) = ($after, "", "");
  1009.             }
  1010.             if (is_true($condition, $substitutions)) {
  1011.                 return substitutions(join("", $before, $iftrue, $anyway), $substitutions, $simple, $ifarray);
  1012.             } else {
  1013.                 return substitutions(join("", $before, $ifelse, $anyway), $substitutions, $simple, $ifarray);
  1014.             }
  1015.         } elsif ($line =~ m|^\s*<#include file[= ]+"(.*)"\s*([\w, ]*)#>\s*$|) {
  1016.             my $filename = substitutions($1, $substitutions, undef, $ifarray);
  1017.             return "" if $PARAMS->{cache}->{notfound}->{$filename};
  1018.             my $px = $2; $px =~ s/\s+/,/g; my @params = split(/,/, $px);
  1019.             undef my $hashref;
  1020.             foreach my $x (@params) {
  1021.                 $hashref->{$x} = 1;
  1022.             }
  1023.             my $text = "";
  1024.             my $flag = 0;
  1025.             if (open(FILE, "< $filename")) {
  1026.                 while (<FILE>) {
  1027.                     s%<IMG SRC="icons/%<IMG SRC="$DCONF->{html_url}/$DCONF->{icon_dir}/%gi;
  1028.                     s%<IMG SRC="$DCONF->{icon_dir}/%<IMG SRC="$DCONF->{html_url}/$DCONF->{icon_dir}/%gi;
  1029.                     if ($hashref->{'BODY'} && m|^<BODY|) {
  1030.                         $flag = 1;
  1031.                     } elsif ($hashref->{'BODY'} && $flag) {
  1032.                         $text .= $_;
  1033.                     } elsif ($hashref->{'BODY'} && !$flag) {
  1034.                         next;
  1035.                     } else {
  1036.                         $text .= $_;
  1037.                     }
  1038.                 }
  1039.                 close (FILE);
  1040.             } else {
  1041.                 template_error("Failed to open required file to generate this portion of the display. $!") if $hashref->{'FATAL'};
  1042.                 $PARAMS->{cache}->{notfound}->{$filename} = 1;
  1043.             }
  1044.             return $text;
  1045.         } elsif ($line =~ m|^\s*<#\s*insert\s*(once)?\s*part\s*\((.*?)\)\s*"([^"]+)"\s*\(?(1?)\)?\s*#>\s*$|i) {
  1046.             my ($once, $topic, $part, $flag) = ($1, $2, $3, $4);
  1047.             $topic = substitutions($topic, $substitutions, $simple, $ifarray);
  1048.             $substitutions->{'_internal'}->{'depth'} += 1;
  1049.             template_error("Recursive Part Call Error: Template depth limited to 50 levels for safety reasons.  Expect a recursive call from a template to itself.  Part called: [$part]; line $line") if $substitutions->{'_internal'}->{'depth'} > 50;
  1050.             if ($once ne "" && defined $PARAMS->{"once,$topic,$part"}) {
  1051.                 performance_string("^ Skin $topic/$part from cache (length " . length($PARAMS->{"once,$topic,$part"}) . " chars)");
  1052.                 $substitutions->{'_internal'}->{'depth'} -= 1;
  1053.                 return $PARAMS->{"once,$topic,$part"};
  1054.             } else {
  1055.                 performance_string("^ Interpreting $topic/$part via insert part");
  1056.             }
  1057.             my $l = part_of_skin($topic, $part, $substitutions, 0, $flag);
  1058.             $substitutions->{'_internal'}->{'depth'} -= 1;
  1059.             $PARAMS->{"once,$topic,$part"} = $l if $once ne "";
  1060.             return $l;
  1061.         } elsif ($line =~ m|^\s*<#\s*insert\s*template\s*"([^"]+)"\s*#>\s*$|i) {
  1062.             my $template = $1;
  1063.             $substitutions->{'_internal'}->{'depth'} += 1;
  1064.             template_error("Recursive Template Call Error: Template depth limited to 50 levels for safety reasons.  Expect a recursive call from a template to itself.  Last template: [$template]") if $substitutions->{'_internal'}->{'depth'} > 50;
  1065.             my $text = templ_int($template, $substitutions);
  1066.             $substitutions->{'_internal'}->{'depth'} -= 1;
  1067.             return $text;
  1068.         } elsif ($line =~ m|^\s*<#form variables#>\s*$|) {
  1069.             my $text = "";
  1070.             foreach my $key (keys(%{$substitutions->{FORMref}})) {
  1071.                 $text .= "<INPUT TYPE=HIDDEN NAME=\"$key\" VALUE=\"$substitutions->{'FORMref'}->{$key}\">\n" if $key !~ m|^_|;
  1072.             }
  1073.             return $text;
  1074.         } elsif ($line =~ m|^\s*<#form variables\(([\w,]+)\)#>\s*$|) {
  1075.             my $text = "";
  1076.             foreach my $key (split(/,/, $1)) {
  1077.                 $text .= "<INPUT TYPE=HIDDEN NAME=\"$key\" VALUE=\"$substitutions->{'FORMref'}->{$key}\">\n";
  1078.             }
  1079.             return $text;
  1080.         } else {
  1081.             return substitutions($line, $substitutions, $simple, $ifarray);
  1082.         }
  1083.     } else {
  1084.         return substitutions($line, $substitutions, $simple, $ifarray);
  1085.     }
  1086. }
  1087.  
  1088. sub form_escape {
  1089.     my ($input) = @_;
  1090.     $input =~ s/&/&/g;
  1091.     $input =~ s/</</g;
  1092.     $input =~ s/>/>/g;
  1093.     $input =~ s/"/"/g;
  1094.     $input =~ s/'/'/g;
  1095.     return $input;
  1096. }
  1097.  
  1098. sub process_sub {
  1099.     my ($subname, $subargs, $substitutions, $ifarray) = @_;
  1100.     $subargs .= ",";
  1101.     $subargs =~ s/\r//g;
  1102.     template_error("Call to undefined subroutine [$subname]!") if ! defined $substitutions->{"_subs"}->{$subname};
  1103.     undef my @sa;
  1104.     while ($subargs =~ m|"([^"]*)"\s*,|) {
  1105.         $subargs = $';
  1106.         push (@sa, substitutions($1, $substitutions, undef, $ifarray));
  1107.     }
  1108.     my $temp_subst = $substitutions;
  1109.     foreach my $y (@{ $substitutions->{"_subs"}->{$subname}->{args} }) {
  1110.         my $z = $y;
  1111.         $z =~ s/^\$//;
  1112.         $temp_subst->{"_"}->{$z} = substitutions(shift(@sa), $temp_subst, undef, $ifarray);
  1113.     }
  1114.     my @temp_code = @{ $substitutions->{"_subs"}->{$subname}->{code} };
  1115.     my $text = (parse_handle(\@temp_code, $temp_subst, undef, $ifarray))[0];
  1116.     return $text;
  1117. }
  1118.  
  1119. sub complex_replace {
  1120.     my ($substitutions, $v1, $v2, $v3, $match) = @_;
  1121.     return $match if $substitutions->{_avoid}->{$v1};
  1122.     return $match if $substitutions->{_avoid}->{$v2};
  1123.     return $substitutions->{$v1}->{$substitutions->{$v2}->{$v3}};
  1124. }
  1125.  
  1126. sub template_js_prepare {
  1127.     my ($text) = @_;
  1128.     my @u = split(/&#?\w+;|<.*?>/, $text);
  1129.     my @v = ();
  1130.     push @v, $1 while ($text =~ m%(&#?\w+;|<.*?>)%g);
  1131.     $text = "";
  1132.     while (scalar(@u) + scalar(@v)) {
  1133.         my $u = shift @u;
  1134.         my $v = shift @v;
  1135.         $u =~ s/\s+/ /g;
  1136.         $u =~ s/(['"<>\\])/join("", "&#", ord($1), ";")/ge;
  1137.         $text .= join("", $u, $v);
  1138.     }
  1139.     foreach my $fc ("'") {
  1140.         my $fcX = ord($fc);
  1141.         my $str = join("", "&#", $fcX, ";");
  1142.         $text =~ s/$str//g;
  1143.         my $fcqm = quotemeta($fc);
  1144.         $text =~ s/$fcqm//g;
  1145.     }
  1146.     return $text;
  1147. }
  1148.  
  1149. sub wordwrapper {
  1150.     my ($chars, $text, $skip_conv) = @_;
  1151.     my $txt = $skip_conv ? $text : char_convert($text, 1);
  1152.     my @Z = split(/\n\n+/, $txt);
  1153.     my @t2out = ();
  1154.     if ($skip_conv) {
  1155.         my @t2in = ();
  1156.         foreach my $z (@Z) {
  1157.             $z =~ s/<!--.*?-->//g;
  1158.             my @u = split(/<.*?>/i, $z);
  1159.             my @v = (); while ($z =~ /(<.*?>)/gi) { push @v, $1; };
  1160.             push @t2in, { u => \@u, v => \@v };
  1161.         }
  1162.         foreach my $z (@t2in) {
  1163.             my @u = @{ $z->{u} };
  1164.             my @v = @{ $z->{v} };
  1165.             while (scalar @u + scalar @v) {
  1166.                 my $u = shift @u;
  1167.                 my $v = shift @v;
  1168.                 $u =~ s/\s+/ /g; $u = trim($u);        
  1169.                 push @t2out, _wrapper($u, $chars);
  1170.                 push @t2out, $v if length($v);
  1171.             }
  1172.             push @t2out, "";
  1173.         }
  1174.         @t2out = grep { /\S/ } @t2out;
  1175.     } else {
  1176.         foreach my $z (@Z) {
  1177.             $z =~ s/\n/<br>/g;
  1178.             $z = trim($z);
  1179.             $z =~ s/<br>/\n/gi;
  1180.             $z =~ s/<!--.*?-->//g;
  1181.             $z = remove_html($z);
  1182.             push @t2out, _wrapper($z, $chars);
  1183.             push @t2out, "";
  1184.         }
  1185.     }
  1186.     return join("\n", @t2out);    
  1187. }
  1188.  
  1189. sub _wrapper {
  1190.     my ($text, $chars) = @_;
  1191.     my @aout = ();
  1192.     while ($text ne "") {
  1193.         if ($text =~ /^(.{1,$chars})(\s|$)/) {
  1194.             push @aout, $1; $text = $';
  1195.         } elsif ($text =~ /^\n/) {
  1196.             push @aout, ""; $text = $';
  1197.         } elsif ($text =~ /^(.{$chars,})(\s|$)/) {
  1198.             push @aout, $1; $text = $';
  1199.         }
  1200.     }
  1201.     return @aout;
  1202. }
  1203.  
  1204. sub safe_minus_one {
  1205.     my ($num) = @_;
  1206.     my $x = int($num - 1);
  1207.     template_error("Invalid Array Index: $num is less than one") if $x < 0;
  1208.     return $x;
  1209. }
  1210.  
  1211. sub substitutions {
  1212.     my ($text, $substitutions, $simple, $ifarray) = @_;
  1213.     $text =~ s/\r//g;
  1214.     my $K = $text =~ s%(\$|\{|\}|\\|<#|#>)%\r$1\r%g;
  1215.     if ($K) {
  1216.         $text =~ s%\r\$\r0%$0%g;
  1217.         $text =~ s%\r<#\r\s*&\s*(\w+)\s*\(([^\)]*)\s*\)\s*\r#>\r%process_sub($1, $2, $substitutions, $ifarray)%ieg;
  1218.         if ($simple) {
  1219.             if ($text =~ /\$/) {
  1220.                 $text =~ s%\r\$\r(\w+)/%if(!$substitutions->{_avoid}->{$1}){single_replace($1,$substitutions)."/"}else{$&."/"}%ge;
  1221.                 $text =~ s%\r\$\rL\r(->)?\{\r(\w+)\r\}\r\[(.*?)\]%read_language()->{$2}->[substitutions($3, $substitutions, $simple, $ifarray)]%ge;
  1222.                 $text =~ s%\r\$\rL\r(->)?\{\r(\w+)\r\}\r%read_language()->{$2}%ge;
  1223.                 $text =~ s%\r\$\rGLOBAL_OPTIONS\r(?:->)?\{\r(\w+)\r\}\r%$GLOBAL_OPTIONS->{$1}%g;
  1224.                 $text =~ s%\r\$\rGLOBAL_OPTIONS\r(?:->)?\{\r\r\$\r(\w+)\r\}\r%$GLOBAL_OPTIONS->{single_replace($1,$substitutions)}%ge;
  1225.                 $text =~ s%\r\$\r(\w+)->\r\{\r(\w+)\r\}\r%if(!$substitutions->{_avoid}->{$1}){$substitutions->{$1}->{$2}}else{$&}%ge;
  1226.                 $text =~ s%\r\$\rENV\r\{\r(\w+)\r\}\r%$ENV{$1}%g;
  1227.                 $text =~ s%\r\$\r(\w+)%if(!$substitutions->{_avoid}->{$1}){single_replace($1,$substitutions)}else{$&}%ge;
  1228.             }
  1229.             $text =~ s%\r\\\ru(\w?)%ucase($1)%ge;
  1230.             $text =~ s%\r\\\rl(\w?)%lcase($1)%ge;
  1231.             if ($text =~ /#/) {
  1232.                 $text =~ s%\r<#\rform\s*escape\s*"(.*?)"\s*\r#>\r%form_escape($1)%iges;
  1233.                 $text =~ s%\r<#\rescape "(.*?)"\r#>\r%escape($1)%gies;
  1234.                 $text =~ s%\r<#\runescape "(.*?)"\r#>\r%unescape($1)%gie;
  1235.                 $text =~ s%\r<#\rremove\s+html\s*"(.*?)"\r#>\r%remove_html($1)%gies;
  1236.                 $text =~ s%\r<#\rjavascript[ _]prepare\s*"(.*?)"\s*\r#>\r%template_js_prepare($1)%gies;
  1237.                 $text =~ s%\r<#\rmaxchar (\d+)/(.*?) "(.*?)"\r#>\r%maxcharcut($1, $2, $3)%gies;
  1238.                 $text =~ s%\r<#\rmaxchar (\d+) "(.*?)"\r#>\r%substrnohtml($2, $1)%gies;
  1239.                 $text =~ s%\r<#\rpart\s*"(.*?)"\s*\((\d*)\)\s*exists\s*\r#>\r%part_of_skin($2, $1, $substitutions, 1)%gies;    
  1240.                 $text =~ s%\r<#\rcss\s*size\s*\(([\-\+\d]+)\)\s*\r#>\r%template_css_size($1)%gies;    
  1241.                 while ($text =~ m|\r<#\rpick\s*(\w+)?\s*(.*?)\s*from\s*\@(\w+)\s*\((.*?)\)\s*\r#>\r|i) {
  1242.                     my ($pick, $item_no, $arrayname, $item_choice, $before, $after, $match) = ($1, $2, $3, $4, $`, $', $&);
  1243.                     if (ref $substitutions->{$arrayname} ne "ARRAY") {
  1244.                         $match =~ s/</</g; $match =~ s/>/>/g;
  1245.                         &template_error("Use of undefined array \@$arrayname in statement [$match]!");
  1246.                     }
  1247.                     $item_choice =~ s/\s//g;
  1248.                     my @item_choose = split(/,/, $item_choice);
  1249.                     if ($item_choice eq "*") {
  1250.                         if (scalar(@{ $substitutions->{$arrayname} }) == 0) {
  1251.                             $text = join("", $before, $after);
  1252.                             next;
  1253.                         } else {
  1254.                             @item_choose = (1 .. scalar(@{ $substitutions->{$arrayname} }));
  1255.                         }
  1256.                     }
  1257.                     if (scalar(@item_choose) == 0) {
  1258.                         template_error("Invalid selection index '$item_choice' in [$match]!");
  1259.                     }
  1260.                     my $arrindex = ($item_no - 1) % scalar(@item_choose);
  1261.                     &template_error("Use of undefined index [ $item_choose[$arrindex] ] for array index $arrindex in item choices ($item_choice)!") unless (@{ $substitutions->{$arrayname} })[ $item_choose[$arrindex] - 1 ];
  1262.                     $text = join("", $before, ( (@{ $substitutions->{$arrayname} })[ $item_choose[$arrindex] - 1 ])->{$pick}, $after);
  1263.                 }
  1264.                 while ($text =~ m|\r<#\rdate\s+([\d\.]*)\s+format\s+"(.*?)"\s*\r#>\r|i) {
  1265.                     my ($datenum, $format, $before, $after) = ($1, $2, $`, $');
  1266.                     if ($datenum != 0) {
  1267.                         $text = join("", $before, get_date_time($format, int($datenum), 0), $after);
  1268.                     } else {
  1269.                         $text = join("", $before, " ", $after);
  1270.                     }
  1271.                 }
  1272.             }
  1273.         } else {
  1274.             if ($text =~ /\$/) {
  1275.                 $text =~ s%\r\$\r(\w+)/%if(!$substitutions->{_avoid}->{$1}){single_replace($1,$substitutions)."/"}else{$&."/"}%ge;
  1276.                 $text =~ s%\r\$\rL\r(->)?\{\r(\w+)\r\}\r\[(.*?)\]%read_language()->{$2}->[substitutions($3, $substitutions, $simple, $ifarray)]%ge;
  1277.                 $text =~ s%\r\$\rL\r(->)?\{\r(\w+)\r\}\r%read_language()->{$2}%ge;
  1278.                 $text =~ s%\r\$\rENV\r\{\r(\w+)\r\}\r%$ENV{$1}%g;
  1279.                 $text =~ s%\r\$\rGLOBAL_OPTIONS\r(?:->)?\{\r(\w+)\r\}\r%$GLOBAL_OPTIONS->{$1}%g;
  1280.                 $text =~ s%\r\$\rGLOBAL_OPTIONS\r(?:->)?\{\r\r\$\r(\w+)\r\}\r%$GLOBAL_OPTIONS->{single_replace($1,$substitutions)}%ge;
  1281.                 if ($text =~ /\$/) {
  1282.                     $text =~ s%\r\$\rsubstitutions->\r\{\r(\w+)\r\}\r%$substitutions->{$1}%g;
  1283.                     $text =~ s%\r\$\r(\w+)\[\r\$\r(\w+)->\r\{\r(\w+)\r\}\r\]->\r\{\r(\w+)\r\}\r%$substitutions->{$1}->[-1+($substitutions->{$2}->{$3})]->{$4}%ge;
  1284.                     $text =~ s%\r\$\r(\w+)\[\r\$\r(\w+)->\r\{\r(\w+)\r\}\r\]%$substitutions->{$1}->[safe_minus_one($substitutions->{$2}->{$3})]%ge;
  1285.                     $text =~ s%\r\$\r(\w+)\[(\d+)\]->\r\{\r(\w+)\r\}\r%$substitutions->{$1}[safe_minus_one($2)]->{$3}%g;
  1286.                     $text =~ s%\r\$\r(\w+)->\r\{\r(\w+)\r\}\r->\r\{\r(\w+)\r\}\r%$substitutions->{$1}->{$2}->{$3}%g;
  1287.                     $text =~ s%\r\$\r(\w+)->\r\{\r(\w+)\r\}\r->\r\{\r\r\$\r(\w+)\r\}\r%$substitutions->{$1}->{$2}->{single_replace($3, $substitutions)}%ge;
  1288.                     $text =~ s%\r\$\r(\w+)->\r\{\r\r\$\r(\w+)->\r\{\r(\w+)\r\}\r\r\}\r%complex_replace($substitutions, $1, $2, $3, $&)%ge;
  1289.                     $text =~ s%\r\$\r(\w+)->\r\{\r\r\$\r(\w+)\r\}\r%$substitutions->{$1}->{single_replace($2,$substitutions)}%ge;
  1290.                     $text =~ s%\r\$\r(\w+)->\r\{\r(\w+)\r\}\r%if(!$substitutions->{_avoid}->{$1}){$substitutions->{$1}->{$2}}else{$&}%ge;
  1291.                     $text =~ s%\r\$\r(\w+)\[(.*?)\]->\r\{\r(\w+)\r\}\r%$substitutions->{$1}[safe_minus_one(substitutions($2, $substitutions, $simple, $ifarray))]->{$3}%ge;
  1292.                     $text =~ s%\r\$\r(\w+)\[(.*?)\]%$substitutions->{$1}[safe_minus_one(substitutions($2, $substitutions, $simple, $ifarray))]%ge;
  1293.                     $text =~ s%\r\$\r(\w+)%if(!$substitutions->{_avoid}->{$1}){single_replace($1,$substitutions)}else{$&}%ge;
  1294.                     $text =~ s%\r\$\r#(\w+)%ref $substitutions->{$1} eq "ARRAY" ? scalar(@{$substitutions->{$1}}) : 0%ge;
  1295.                     $text =~ s%\r\$\r\@(\w+)->\r\{\r(\w+):\s*(\w+)\s*=\s*"(.*?)"\r\}\r%element_array_grep($substitutions, $3, $4, $1, $2, $&)%ge;
  1296.                 }
  1297.             }
  1298.             $text =~ s%\r\\\ru(\w?)%ucase($1)%ge;
  1299.             $text =~ s%\r\\\rl(\w?)%lcase($1)%ge;
  1300.             if ($text =~ /#/) {
  1301.                 $text =~ s%\r<#\rform\s*escape\s*"(.*?)"\s*\r#>\r%form_escape($1)%iges;
  1302.                 $text =~ s%\r<#\rrepeated (\d+) "(.*?)"\r#>\r%$2x$1%gie;
  1303.                 $text =~ s%\r<#\rescape "(.*?)"\r#>\r%escape($1)%gies;
  1304.                 $text =~ s%\r<#\runescape "(.*?)"\r#>\r%unescape($1)%gie;
  1305.                 $text =~ s%\r<#\rremove\s+html\s*"(.*?)"\r#>\r%remove_html($1)%gies;
  1306.                 $text =~ s%\r<#\rjavascript[ _]prepare\s*"(.*?)"\s*\r#>\r%template_js_prepare($1)%gies;
  1307.                 $text =~ s%\r<#\rmaxchar (\d+)/(.*?) "(.*?)"\r#>\r%maxcharcut($1, $2, $3)%gies;
  1308.                 $text =~ s%\r<#\rmaxchar (\d+) "(.*?)"\r#>\r%substrnohtml($2, $1)%gies;
  1309.                 $text =~ s%\r<#\rpart\s*"(.*?)"\s*\((\d*)\)\s*exists\s*\r#>\r%part_of_skin($2, $1, $substitutions, 1)%gies;    
  1310.                 $text =~ s%\r<#\rcss\s*size\s*\(([\-\+\d]+)\)\s*\r#>\r%template_css_size($1)%gies;    
  1311.                 if ($text =~ /#/) {
  1312.                     $text =~ s%\r<#\rprogram\s*sub\s*"(.*?)"\s*&(\w+)\s*\((.*?)\)\s*\r#>\r%program_sub($1, $2, $3)%gies;
  1313.                     $text =~ s%\r<#\rwordwrap (\d+) "((.|\n)*?)"\r#>\r%wordwrapper($1, $2, 0)%gei;
  1314.                     $text =~ s%\r<#\rwordwrapX (\d+) "((.|\n)*?)"\r#>\r%wordwrapper($1, $2, 1)%gei;
  1315.                     $text =~ s%\r<#\rrtpad (\d+) "(.*?)"\r#>\r%substr(join("", $2, " " x $1), 0, $1)%gei;
  1316.                     $text =~ s%\r<#\rstrlength "(.*?)"\r#>\r%length($1)%geis;
  1317.                     $text =~ s%\r<#\rlength "(.*?)"\r#>\r%nohtmllength($1)%gei;
  1318.                     while ($text =~ m|\r<#\r\s*gmtoffset\s*\r#>\r|i) {
  1319.                         my $time = time;
  1320.                         my ($s1, $m1, $hr1, $mo1, $dy1, $yr1) = localtime($time);
  1321.                         my ($s2, $m2, $hr2, $mo2, $dy2, $yr2) = gmtime($time);
  1322.                         my $offset = ($s1 - $s2);
  1323.                         $offset += 60 * ($m1 - $m2);
  1324.                         $offset += 60 * 60 * ($hr1 - $hr2);
  1325.                         $offset += 24 * 60 * 60 if ($mo1 > $mo2);
  1326.                         $offset -= 24 * 60 * 60 if ($mo1 < $mo2);
  1327.                         $offset += 24 * 60 * 60 if ($mo1 == $mo2 && $dy1 > $dy2);
  1328.                         $offset -= 24 * 60 * 60 if ($mo1 == $mo2 && $dy1 < $dy2);
  1329.                         $text = join("", $`, $offset, $');
  1330.                     }
  1331.                     while ($text =~ m|\r<#\rpick\s*(\w+)?\s*(.*?)\s*from\s*\@(\w+)\s*\((.*?)\)\s*\r#>\r|i) {
  1332.                         my ($pick, $item_no, $arrayname, $item_choice, $before, $after, $match) = ($1, $2, $3, $4, $`, $', $&);
  1333.                         if (ref $substitutions->{$arrayname} ne "ARRAY") {
  1334.                             $match =~ s/</</g; $match =~ s/>/>/g;
  1335.                             &template_error("Use of undefined array \@$arrayname in statement [$match]!");
  1336.                         }
  1337.                         $item_choice =~ s/\s//g;
  1338.                         my @item_choose = split(/,/, $item_choice);
  1339.                         if ($item_choice eq "*") {
  1340.                             if (scalar(@{ $substitutions->{$arrayname} }) == 0) {
  1341.                                 $text = join("", $before, $after);
  1342.                                 next;
  1343.                             } else {
  1344.                                 @item_choose = (1 .. scalar(@{ $substitutions->{$arrayname} }));
  1345.                             }
  1346.                         }
  1347.                         if (scalar(@item_choose) == 0) {
  1348.                             template_error("Invalid selection index '$item_choice' in [$match]!");
  1349.                         }
  1350.                         my $arrindex = ($item_no - 1) % scalar(@item_choose);
  1351.                         &template_error("Use of undefined index [ $item_choose[$arrindex] ] for array index $arrindex in item choices ($item_choice)!") unless (@{ $substitutions->{$arrayname} })[ $item_choose[$arrindex] - 1 ];
  1352.                         $text = join("", $before, ( (@{ $substitutions->{$arrayname} })[ $item_choose[$arrindex] - 1 ])->{$pick}, $after);
  1353.                     }
  1354.                     while ($text =~ m|\r<#\rgrep\s*"?(.*?)"?\s*=?\s*"?(\w+)"?\s*\(?\s*\@(\w+)\s*\)?\s*=?>?\s*"?(\w+)"?\s*\r#>\r|i) {
  1355.                         $text = join("", $`, element_array_grep($substitutions, $1, $2, $3, $4, $&), $');
  1356.                     }    
  1357.                     if ($text =~ m|\r<#\r.*current\s*time.*\r#>\r|i) {
  1358.                         my $time = time;
  1359.                         $text =~ s%\r<#\rcurrent\s*time\r#>\r%$time%ig;
  1360.                     }
  1361.                     while ($text =~ m|\r<#\rdate\s+([\d\.]*)\s+format\s+"(.*?)"\s*\r#>\r|i) {
  1362.                         my ($datenum, $format, $before, $after) = ($1, $2, $`, $');
  1363.                         if ($datenum != 0) {
  1364.                             $text = join("", $before, get_date_time($format, int($datenum), 0), $after);
  1365.                         } else {
  1366.                             $text = join("", $before, " ", $after);
  1367.                         }
  1368.                     }
  1369.                     $text =~ s/\r<#\rskip\s*iteration\r#>\r/<#skip iteration#>/gi;
  1370.                     $text =~ s/\r<#\rnext\r#>\r/<#next#>/gi;
  1371.                 }
  1372.             }
  1373.         }
  1374.     }
  1375.     if ($text =~ m|^\s*\r|) {
  1376.         my $a = $'; $a =~ s/^\s+//; $text = join("", "\r", $a);
  1377.     } else {
  1378.         $text =~ s/^\s+//;
  1379.     }
  1380.     if ($text =~ /\r/) {
  1381.         $text =~ s/\r\{\r\|\r\}\r//g;
  1382.         $text =~ s/\r\{\r(\|+)\r\}\r/" " x (length($1)-1)/ge;
  1383.         $text =~ s%\r\{\r\|tab\|\r\}\r%\t%ig;
  1384.         $text =~ s/\r([\{\}\\])\r/$1/g;
  1385.         $text =~ s/\r<#\r(\w+)\r#>\r/<#$1#>/g;
  1386.     }
  1387.     if ($text =~ /\r/ && ($text =~ m|\r\$\r| || $text =~ m|\r<#\r| || $text =~ m|\r#>\r|)) {
  1388.         my $msg = "<p>Unmatched command code problem</p>\n";
  1389.         $msg .= "<p>Command code used: <u>";
  1390.         my $m = $&; $m =~ s/\r//g; $m =~ s/([^\w\s])/join("", "&#", ord($1), ";")/ge;
  1391.         $msg .= "$m</u></p>\n";
  1392.         $msg .= "<p>Used in line:</p><p>";
  1393.         my $l = $text; $l =~ s/([^\w\s])/join("", "&#", ord($1), ";")/ge; $l =~ s/\r/<!--\\r-->/g; 
  1394.         $msg .= "$l</p>\n";
  1395.         if ($text =~ m|\r<#\r\s*(\S+)|) {
  1396.             $msg .= "<p>Perhaps the command <#$1 ... #> does not exist?</p>";
  1397.         }
  1398.         template_error($msg);
  1399.     }
  1400.     if ($GLOBAL_OPTIONS->{'version_verify'}) {
  1401.         my $str1 = "<is><dfoufs><gpou dpmps=#gg0000 tjaf=4>Uijt tpguxbsf jt cfjoh vtfe jo wjpmbujpo pg jut mjdfotf bhsffnfou.</gpou></dfoufs><is>"; $str1 =~ tr/B-ZAb-za/A-Za-z/;
  1402.         my $str2 = "<is><dfoufs><gpou dpmps=#gg0000 tjaf=4>Qmfbtf fodpvsbhf uif cpbse benjojtusbups up qspqfsmz sfhjtufs uijt tpguxbsf.</gpou></dfoufs><is>"; $str2 =~ tr/B-ZAb-za/A-Za-z/;
  1403.         $text =~ s/<body([^>]*)>/<body$1>$str1/ig;
  1404.         $text =~ s/<\/body([^>]*)>/<\/body$1>$str2/ig;
  1405.     }
  1406.     $text =~ s/\s*\\\s*$//;
  1407.     return $text;
  1408. }
  1409.  
  1410. sub program_sub {
  1411.     my ($requirement, $subroutine, $arguments) = @_;
  1412.     dreq($requirement) if $requirement ne "";
  1413.     my @arg = split(/,/, $arguments);
  1414.     foreach my $argu (@arg) {
  1415.         $argu = trim($argu);
  1416.         $argu = $1 if $argu =~ /"(.*)"/;
  1417.     }
  1418.     my $j = \&{ $subroutine };
  1419.     my $K = eval '&{ $j }(@arg);';
  1420.     return $K;
  1421. }
  1422.  
  1423. sub element_array_grep {
  1424.     my ($substitutions, $element, $pattern, $arrayname, $return_key, $match) = @_;
  1425.     return "" if $pattern eq "";
  1426.     if (ref $substitutions->{$arrayname} ne "ARRAY") {
  1427.         $match =~ s/</</g; $match =~ s/>/>/g;
  1428.         template_error("Use of undefined array \@$arrayname in grep statement [$match]");
  1429.     }
  1430.     my $x = (grep($_->{$element} eq $pattern, @{ $substitutions->{$arrayname} }))[0];
  1431.     return "" if ref $x ne "HASH";
  1432.     return $x->{$return_key};
  1433. }
  1434.  
  1435. sub template_css_size {
  1436.     my ($sized) = @_;
  1437.     my $s = 0;
  1438.     if ($sized =~ m|^\+|) {    
  1439.         $s = $GLOBAL_OPTIONS->{COLOR_size} + $';
  1440.     } elsif ($sized =~ m|^\-|) {
  1441.         $s = $GLOBAL_OPTIONS->{COLOR_size} - $';
  1442.     } else {
  1443.         $s = $sized;
  1444.     }
  1445.     $s = 1 if $s < 1;
  1446.     $s = 7 if $s > 7;
  1447.     $s = int($s);
  1448.     my @u = ('', '8pt', '10pt', '12pt', '14pt', '18pt', '24pt', '36pt');
  1449.     return $u[$s];    
  1450. }
  1451.  
  1452. sub nohtmllength {
  1453.     my ($text) = @_;
  1454.     return substrnohtml($text, length($text), 1);    
  1455. }
  1456.  
  1457. sub maxcharcut {
  1458.     my ($chars, $cutreplace, $text) = @_;
  1459.     $text =~ s%<!-/?\*\d+-!>%%g;
  1460.     $text =~ s%<!-\*\d+:\S*-!>%%g;
  1461.     return $text if length($text) <= $chars;
  1462.     my $clen = $chars - length($cutreplace);    
  1463.     return $text if $clen <= 0;
  1464.     return join("", substrnohtml($text, $clen), $cutreplace);    
  1465. }
  1466.  
  1467. sub substrnohtml {
  1468.     my ($text, $leng, $arg) = @_;
  1469.     return $text if length($text) <= $leng && ! $arg;
  1470.     return substr($text, 0, $leng) if ($text !~ m|&#?(\w+);| && $text !~ m|<.*>|) && ! $arg;
  1471.     return length($text) if ($text !~ m|&#?(\w+);| && $text !~ m|<.*>|) && $arg;
  1472.     my @u = split(/&#?\w+;|<.*?>/, $text);
  1473.     my @v = ();
  1474.     push @v, $1 while ($text =~ m%(&#?\w+;|<.*?>)%g);
  1475.     $text = "";
  1476.     my $length_used = 0;
  1477.     while (scalar(@u) + scalar(@v)) {
  1478.         my $u = shift @u;
  1479.         my $v = shift @v;
  1480.         my $x = substr($u, 0, $leng - $length_used);
  1481.         if ($x eq $u) {
  1482.             $length_used += length($u);
  1483.             $text .= $u;
  1484.         } else {
  1485.             $length_used = $leng;
  1486.             $text .= $x;
  1487.         }
  1488.         if ($v =~ /^&#?\w+;/ && $length_used < $leng) {
  1489.             $text .= $v; $length_used += 1;
  1490.         } elsif ($v =~ /^<img/i && $length_used < $leng) {
  1491.             $text .= $v; $length_used += 1;
  1492.         } elsif ($v =~ /^<img/i) {
  1493.             # Don't add additional images here
  1494.         } elsif ($v =~ /^</) {
  1495.             $text .= $v;
  1496.         }
  1497.     }
  1498.     return $text if ! $arg;
  1499.     return $length_used;
  1500. }
  1501.  
  1502. sub single_replace {
  1503.     my ($text, $substitutions, $next) = @_;
  1504. #    header();
  1505. #    print "TEXT: $text<br>\n";
  1506. #    print "Defined: ", 0 + defined $substitutions->{"_"}->{$text}, "<br>\n";
  1507. #    print "Value: ", $substitutions->{"_"}->{$text}, "<br>\n" if defined $substitutions->{"_"}->{$text};
  1508. #    print "DCONF: ", $DCONF->{$text}, "<br>\n" if defined $DCONF->{$text};
  1509. #    print "PARAMS: ", $PARAMS->{$text}, "<br>\n" if defined $PARAMS->{$text};
  1510.     return $substitutions->{"_"}->{$text} if defined($substitutions->{"_"}->{$text});
  1511.     return $DCONF->{$text} if defined($DCONF->{$text});
  1512.     return $PARAMS->{$text} if defined($PARAMS->{$text});
  1513.     return undef;
  1514. }
  1515.  
  1516. sub ucase {
  1517.     return case_upper($_[0]);
  1518. }
  1519.  
  1520. sub lcase {
  1521.     return case_lower($_[0]);
  1522. }
  1523.  
  1524. sub is_true {
  1525.     my ($statement, $substitutions) = @_;
  1526.     my $y = "==|!=|>|<|>=|<=|eq|ne|gt|ge|lt|le|rexp=~|rexp!~|=~|!~";
  1527.     my @condx = ();
  1528.     if ($statement =~ m|&&|) {
  1529.         @condx = split(/&&/, $statement);
  1530.     } elsif ($statement =~ m#\|\|#) {
  1531.         @condx = split(/\|\|/, $statement);
  1532.     } else {
  1533.         @condx = ($statement);
  1534.     }
  1535.     my $boolean = "or";
  1536.     $boolean = "and" if $statement =~ m|&&|;
  1537.     my $xx = 0;
  1538.     foreach my $condx (@condx) {
  1539.         $condx =~ s/\s+$//;
  1540.         $condx =~ s/^\s+//;
  1541.         $condx =~ s/\s+/ /g;
  1542.         next if $condx eq "";
  1543.         if ($condx =~ m|^pro$|i) {
  1544.             return 1 if $DCONF->{pro} && $boolean eq "or";
  1545.             return 0 if !$DCONF->{pro} && $boolean eq "and";
  1546.         } elsif ($condx =~ m|^\!(\s*)pro$|i) {
  1547.             return 1 if !$DCONF->{pro} && $boolean eq "or";
  1548.             return 0 if $DCONF->{pro} && $boolean eq "and";
  1549.         } elsif ($condx =~ m%^(.+)\s+($y)\s+(.+)$%o) {
  1550.             $xx = &_is_true($1, $2, $3, $substitutions);
  1551.             return 1 if $xx && $boolean eq "or";
  1552.             return 0 if !$xx && $boolean eq "and";
  1553.         } elsif ($condx =~ m%^(.+)$%) {
  1554.             $xx = &_is_true($1, ">=", "1", $substitutions);
  1555.             return 1 if $xx && $boolean eq "or";
  1556.             return 0 if !$xx && $boolean eq "and";
  1557.         } else {
  1558.             &template_error("Template for this section is corrupt: bad "if" statement! [$statement] [$condx]");
  1559.         }
  1560.     }
  1561.     return 1 if $boolean eq "and";
  1562.     return 0 if $boolean eq "or";
  1563. }
  1564.  
  1565. sub _minimath {
  1566.     my ($value, $substitutions) = @_;
  1567.     my $y = '\-|\+|\*|\/|\%';
  1568.     my @p = split(/$y/, $value);
  1569.     template_error(join("", "Bad math expression: [$value] had  ", scalar(@p), " argument(s); 2 expected")) if scalar(@p) != 2;
  1570.     my ($pa, $pb) = (trim($p[0]), trim($p[1]));
  1571.     my $P1 = substitutions($pa, $substitutions);
  1572.     my $P2 = substitutions($pb, $substitutions);
  1573.     my $V = $1 if $value =~ /($y)/;
  1574.     my $v = 0;
  1575.     $v = $P1 + $P2 if $V eq "+";
  1576.     $v = $P1 - $P2 if $V eq "-";
  1577.     $v = $P1 * $P2 if $V eq "*";
  1578.     if ($V eq "%" || $V eq "/") {
  1579.         if ($P2 == 0) {
  1580.             $v = 0;
  1581.         } else {
  1582.             $v = $P1 / $P2 if $V eq "/";
  1583.             $v = $P1 % $P2 if $V eq "%";
  1584.         }
  1585.     }
  1586.     return $v;
  1587. }
  1588.  
  1589. sub _is_true {
  1590.     my ($value1, $c, $value2, $substitutions) = @_;
  1591.     $value1 = $1 if $value1 =~ m|^"(.*)"$|;
  1592.     $value2 = $1 if $value2 =~ m|^"(.*)"$|;
  1593.     $value2 = $1 if $value2 =~ m|^match\s*\((.*?)\)\s*$|;
  1594.     if ($value1 =~ m|^\[(.*?)\]$|) {
  1595.         $value1 = substitutions($value1, $substitutions);
  1596.         $value1 = _minimath($1, $substitutions) if $value1 =~ m|^\[(.*?)\]$|;
  1597.     } else {
  1598.         $value1 = substitutions($value1, $substitutions);
  1599.     }        
  1600.     if ($value2 =~ m|^\[(.*?)\]$|) {
  1601.         $value2 = substitutions($value2, $substitutions);
  1602.         $value2 = _minimath($1, $substitutions) if $value2 =~ m|^\[(.*?)\]$|;
  1603.     } else {
  1604.         $value2 = substitutions($value2, $substitutions);
  1605.     }        
  1606.     $value1 =~ s%\s*exists:\s*"(.*?)"\s*%-f $1 ? 1 : 0%ge;
  1607.     $value1 =~ s%\s*option_defined:\s*"(.*?)"\s*%if(defined $GLOBAL_OPTIONS->{$1}) {1} else {0}%ge;
  1608.     return 0 if $c eq "==" && $value1 == 0 && $value2 == 0 && $value1 =~ m|\D|;
  1609.     return 1 if $c eq "==" && $value1 == $value2;
  1610.     return 1 if $c eq "!=" && $value1 != $value2;
  1611.     return 1 if $c eq ">=" && $value1 >= $value2;
  1612.     return 1 if $c eq "<=" && $value1 <= $value2;
  1613.     return 1 if $c eq ">"  && $value1 >  $value2;
  1614.     return 1 if $c eq "<"  && $value1 <  $value2;
  1615.     return 1 if $c eq "eq" && $value1 eq $value2;
  1616.     return 1 if $c eq "ne" && $value1 ne $value2;
  1617.     return 1 if $c eq "gt" && $value1 gt $value2;
  1618.     return 1 if $c eq "lt" && $value1 lt $value2;
  1619.     return 1 if $c eq "ge" && $value1 ge $value2;
  1620.     return 1 if $c eq "le" && $value1 le $value2;
  1621.     if ($c eq "=~" || $c eq "!~") {
  1622.         $value2 =~ m|^(\^?)(.*?)(\$?)$|;
  1623.         my ($o, $qm, $t) = ($1, quotemeta($2), $3);
  1624.         return 1 if $c eq "=~" && $value1 =~ /$o$qm$t/i;
  1625.         return 1 if $c eq "!~" && $value1 !~ /$o$qm$t/i;
  1626.     } elsif ($c eq "rexp=~") {
  1627.         return 1 if $value1 =~ /$value2/i;
  1628.     } elsif ($c eq "rexp!~") {
  1629.         return 1 if $value1 !~ /$value2/i;
  1630.     }
  1631.     return 0;
  1632. }
  1633.  
  1634. sub template_error {
  1635.     my $message = join("</p><p>", @_);
  1636.     header();
  1637.     print "</TD></TR></TABLE></TD></TR></TABLE><P>\n";
  1638.     print "<CENTER><FONT COLOR=#ff0000><B>Template Error</B></FONT></CENTER><HR>\n";
  1639.     print "<p>A template problem or error occurred for the following reason:</p>\n";
  1640.     print "<p><B>$message</B></P>\n";
  1641.     print "</BODY></HTML>\n";
  1642.     program_exit(0);
  1643. }
  1644.  
  1645. 1;
  1646.