home *** CD-ROM | disk | FTP | other *** search
/ rtsi.com / 2014.01.www.rtsi.com.tar / www.rtsi.com / OS9 / FAQ / discus_admin_1357211388 / source / webtags.pl < prev    next >
Text File  |  2009-11-06  |  19KB  |  558 lines
  1. # FILE: webtags.pl
  2. # DESCRIPTION: Discus Formatting Tags (to and from)
  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 $PARAMS $DCONF);
  17.  
  18. ###
  19. ### webtags
  20. ###
  21. ### Takes input containing \b{formatting tags} and converts it into HTML code as
  22. ### normally used.
  23. ###
  24.  
  25. sub webtags {
  26.     my ($text_in, $context_code, $situation, $is_moderator, $is_superuser, $topic_number, $force_refresh) = @_;
  27.     return ("", $text_in) if ($GLOBAL_OPTIONS->{'allow_arb_html'} && $situation != 0);
  28.     return ($text_in, $text_in) if ($GLOBAL_OPTIONS->{'allow_arb_html'} && $situation == 0);
  29.     return ("", $text_in) if $text_in !~ /\S/ && $situation != 0;
  30.     return ($text_in, $text_in) if $text_in !~ /\S/ && $situation == 0;
  31.     my @u = ();
  32.     $text_in =~ s/\r\n/\n/g; $text_in =~ s/\r/\n/g;
  33.     while ($text_in =~ /(?:^|\n)\s*?\\\*\s*?\n(.*?)\n\s*?\*\\\s*?(?:\n|$)/s) {
  34.         $text_in = $';
  35.         push @u, $`;
  36.         my $one = $1;
  37.         $one =~ s/\\/\\\\/g;
  38.         $one =~ s/\{/\\\{/g;
  39.         $one =~ s/\}/\\\}/g;
  40.         push @u, join("", "\n", $one, "\n");
  41.     }
  42.     push @u, $text_in if $text_in ne "";
  43.     $text_in = char_convert(join("", @u));
  44.     if ($text_in !~ m|\\(\S+)\{|) {
  45.         return ("", $text_in) if $situation != 0;
  46.         return ($text_in, $text_in) if $situation == 0;
  47.     }
  48.     my ($tags, $char) = read_tags($context_code, $is_moderator, $is_superuser, $topic_number, $force_refresh);
  49.     my ($messages, $formatted) = parse("", $text_in, $tags, $char);
  50.     undef my %flagged;
  51.     if ($messages ne "!Error") {
  52.         $formatted =~ s/\\/\/g;
  53.         while ($formatted =~ m|/(\w+)(|g) {
  54.             $messages .= "<LI><B>/$1(...)</B> " . read_language()->{COULDMEAN} . " <B>\\$1\{...\}</B><BR>\n" if ($tags->{$1} ne "" && $flagged{$1} == 0);
  55.             $flagged{$1} = 1;
  56.         }
  57.         while ($formatted =~ m|\\(\w+)(|g) {
  58.             $messages .= "<LI><B>\$1(...)</B> " . read_language()->{COULDMEAN} . " <B>\\$1\{...\}</B><BR>\n" if ($tags->{$1} ne "" && $flagged{$1} == 0);
  59.             $flagged{$1} = 1;
  60.         }
  61.         while ($formatted =~ m|/(\w+)\{|g) {
  62.             $messages .= "<LI><B>/$1\{...\}</B> " . read_language()->{COULDMEAN} . " <B>\\$1\{...\}</B><BR>\n" if ($tags->{$1} ne "" && $flagged{$1} == 0);
  63.             $flagged{$1} = 1;
  64.         }
  65.         while ($formatted =~ m|/(\w+) \{|g) {
  66.             $messages .= "<LI><B>/$1\{...\}</B> " . read_language()->{COULDMEAN} . " <B>\\$1\{...\}</B><BR>\n" if ($tags->{$1} ne "" && $flagged{$1} == 0);
  67.             $flagged{$1} = 1;
  68.         }
  69.         while ($formatted =~ m|/(\w+) (|g) {
  70.             $messages .= "<LI><B>/$1\{...\}</B> " . read_language()->{COULDMEAN} . " <B>\\$1\{...\}</B><BR>\n" if ($tags->{$1} ne "" && $flagged{$1} == 0);
  71.             $flagged{$1} = 1;
  72.         }
  73.         while ($formatted =~ m|\\(\w+) \{|g) {
  74.             $messages .= "<LI><B>/$1\{...\}</B> " . read_language()->{COULDMEAN} . " <B>\\$1\{...\}</B><BR>\n" if ($tags->{$1} ne "" && $flagged{$1} == 0);
  75.             $flagged{$1} = 1;
  76.         }
  77.         while ($formatted =~ m|\\(\w+) (|g) {
  78.             $messages .= "<LI><B>/$1\{...\}</B> " . read_language()->{COULDMEAN} . " <B>\\$1\{...\}</B><BR>\n" if ($tags->{$1} ne "" && $flagged{$1} == 0);
  79.             $flagged{$1} = 1;
  80.         }
  81.     } else {
  82.         $formatted = "<H3>" . read_language()->{FORMATTINGERROR} . "</H3>$formatted";
  83.     }
  84.     if ($situation == 0) {
  85.         return ($formatted, $formatted);
  86.     } else {
  87.         return ($messages, $formatted);
  88.     }
  89. }
  90.  
  91. ###
  92. ### inverse_webtags
  93. ###
  94. ### Takes perfect HTML, presumably generated by "webtags", and converts it
  95. ### to the formatting tags that would give that output.
  96. ###
  97.  
  98. sub inverse_webtags {
  99.     my ($string, $topic_number, $escaped) = @_;
  100. #    $string =~ s/<BR>/\n/gi;
  101.     if ($string =~ /^[\w\s]*$/) {
  102.         $string =~ s/<BR>/\n/gi;
  103.         if ($escaped) {
  104.             $string =~ s/&/&/g;
  105.             $string =~ s/</</g;
  106.             $string =~ s/>/>/g;
  107.             $string =~ s/"/"/g;
  108.         }
  109.         return $string;
  110.     }
  111.     my $tags = read_webtags_conf();
  112.     my @taglist = keys(%{ $tags->{args} });
  113.     my $restrict_tags = {
  114.         mail => 1,
  115.         newurl => 2,
  116.         topurl => 3,
  117.         link => 4,
  118.         rgb => 5,
  119.         font => 6,
  120.         imagelink => 100,
  121.     };
  122.     my $transit_tags = {
  123.         'table' => 1,
  124.         'tablenb' => 2,
  125.         'tablebg' => 2,
  126.         'list' => 5,
  127.         'olist' => 6,
  128.     };
  129.     my $restrict_chars = {
  130.         '**br' => 1,
  131.     };
  132.     if (read_language()->{TABLE_TAG} ne "" && read_language()->{TABLE_TAG} ne "table") {
  133.         $transit_tags->{read_language()->{TABLE_TAG}} = 3;
  134.     }
  135.     if (read_language()->{TABLE_NB_TAG} ne "" && read_language()->{TABLE_NB_TAG} ne "tablenb") {
  136.         $transit_tags->{read_language()->{TABLE_NB_TAG}} = 4;
  137.     }
  138.     if (read_language()->{LIST_TAG} ne "" && read_language()->{LIST_TAG} ne "list") {
  139.         $transit_tags->{read_language()->{LIST_TAG}} = 7;
  140.     }
  141.     if (read_language()->{OLIST_TAG} ne "" && read_language()->{OLIST_TAG} ne "olist") {
  142.         $transit_tags->{read_language()->{OLIST_TAG}} = 8;
  143.     }
  144.     @taglist = sort {
  145.             if ($tags->{cont}->{$b} =~ /c/i && $tags->{cont}->{$a} !~ /c/i) {
  146.                 return 1 if ! $restrict_chars->{$b};
  147.             }
  148.             if ($tags->{cont}->{$b} !~ /c/i && $tags->{cont}->{$a} =~ /c/i) {
  149.                 return -1 if ! $restrict_chars->{$a};
  150.             }
  151.             return -1 if $tags->{tags}->{$b}->[0]->{rexp} =~ /^\\<\w+\\>$/ && $tags->{tags}->{$a}->[0]->{rexp} !~ /^\\<\w+\\>$/;
  152.             return  1 if $tags->{tags}->{$a}->[0]->{rexp} =~ /^\\<\w+\\>$/ && $tags->{tags}->{$b}->[0]->{rexp} !~ /^\\<\w+\\>$/;
  153.             return -1 if $tags->{tags}->{$b}->[0]->{rexp} =~ /^\\&\w+\\;$/ && $tags->{tags}->{$a}->[0]->{rexp} !~ /^\\&\w+\\;$/;
  154.             return  1 if $tags->{tags}->{$a}->[0]->{rexp} =~ /^\\&\w+\\;$/ && $tags->{tags}->{$b}->[0]->{rexp} !~ /^\\&\w+\\;$/;
  155.             return -1 if $tags->{tags}->{$b}->[0]->{rexp} =~ /^\\&\\#\d+\\;$/ && $tags->{tags}->{$a}->[0]->{rexp} !~ /^\\&\\#\d+\\;$/;
  156.             return  1 if $tags->{tags}->{$a}->[0]->{rexp} =~ /^\\&\\#\d+\\;$/ && $tags->{tags}->{$b}->[0]->{rexp} !~ /^\\&\\#\d+\\;$/;
  157.             return  1 if $restrict_tags->{$a} > $restrict_tags->{$b};
  158.             return -1 if $restrict_tags->{$a} < $restrict_tags->{$b};
  159.             return  1 if $transit_tags->{$a} > $transit_tags->{$b};
  160.             return -1 if $transit_tags->{$a} < $transit_tags->{$b};
  161.             return  1 if $tags->{args}->{$a} < $tags->{args}->{$b};
  162.             return -1 if $tags->{args}->{$a} > $tags->{args}->{$b};
  163.             return  1 if length ($tags->{tags}->{$b}->[0]->{rexp}) > length ($tags->{tags}->{$a}->[0]->{rexp});
  164.             return -1 if length ($tags->{tags}->{$b}->[0]->{rexp}) < length ($tags->{tags}->{$a}->[0]->{rexp});
  165.             return  1 if $tags->{order}->{$a} < $tags->{order}->{$b};
  166.             return -1 if $tags->{order}->{$a} > $tags->{order}->{$b};
  167.             return $a cmp $b;
  168.         } @taglist;
  169.     my $did_charconvert = 0;
  170.     while ($string =~ m%<!--?\*(\d+)-[-!]>.*<!--?\*\1:(.*?)-[-!]>%s) {
  171.         $string = join("", $`, unescape($2), $');
  172.     }
  173. FT:    foreach my $tag (@taglist) {
  174.         my @u = sort { length($b->{rexp}) <=> length($a->{rexp}) } @{ $tags->{tags}->{$tag} };
  175.         if ($restrict_tags->{$tag} >= 100 && ! $did_charconvert) {
  176.             $string =~ s/\\char\{(\d+)\}/&#$1;/g;
  177.             $string = char_convert($string, 1);
  178.             $string =~ s/&#(\d+);/\\char\{$1\}/g;
  179.             $did_charconvert = 1;
  180.         }
  181.         my $xxflag = 0;
  182. UI:        foreach my $u (@u) {
  183.             next UI if $u->{rexp} !~ /\S/;
  184.             my $STRING_HOLD = "";
  185. WI:            while ($string =~ /$u->{rexp}/is) {
  186.                 my ($bef, $aft, $mat, $i) = find_inner($string, $u->{rexp});
  187.                 my @i = @{$i};
  188.                 if ($tags->{cont}->{$tag} =~ /c/i) {
  189.                     my $tag2 = $tag;
  190.                     $tag2 = $' if $tag =~ /^\*\*/;
  191.                     $string = join("", $bef, "\\ch\{$tag2\}", $aft);
  192.                 } else {
  193.                     if ($transit_tags->{$tag} > 0) {
  194.                         my $t = "\\$tag\{";
  195.                         my @t = (); my $ctr = 0;
  196.                         foreach my $k (keys(%{ $u->{lookup} })) {
  197.                             $t[$k-1] = $i[$u->{lookup}->{$k}->{num}-1] if ! $u->{lookup}->{$k}->{esc};
  198.                             $t[$k-1] = unescape($i[$u->{lookup}->{$k}->{num}-1]) if $u->{lookup}->{$k}->{esc};
  199.                         }
  200.                         $t[$#t] = transit($t[$#t], $transit_tags->{$tag});
  201.                         $t .= join(",", @t);
  202.                         $t .= "}";
  203.                         if ($t =~ /^([^<]*)>/) {
  204.                             $mat =~ /(.*?)>/;
  205.                             $string = join("", $', $aft);
  206.                             $STRING_HOLD = join("", $STRING_HOLD, $bef, $1, ">");
  207.                             next WI;
  208.                         }
  209.                         $string = join("", $bef, $t, $aft);
  210.                     } else {
  211.                         my $t = "\\$tag\{";
  212.                         my @t = (); my $ctr = 0;
  213.                         foreach my $k (keys(%{ $u->{lookup} })) {
  214.                             $t[$k-1] = $i[$u->{lookup}->{$k}->{num}-1] if ! $u->{lookup}->{$k}->{esc};
  215.                             $t[$k-1] = unescape($i[$u->{lookup}->{$k}->{num}-1]) if $u->{lookup}->{$k}->{esc};
  216.                         }
  217.                         $t .= join(",", @t);
  218.                         $t .= "}";
  219.                         if ($t =~ /^([^<]*)>/) {
  220.                             $mat =~ /(.*?)>/;
  221.                             $string = join("", $', $aft);
  222.                             $STRING_HOLD = join("", $STRING_HOLD, $bef, $1, ">");
  223.                             next WI;
  224.                         }
  225.                         $string = join("", $bef, $t, $aft);
  226.                     }
  227.                 }
  228.             }
  229.         $string = join("", $STRING_HOLD, $string);
  230.         }
  231.     }
  232.     if (! $did_charconvert) {
  233.         $string =~ s/\\char\{(\d+)\}/&#$1;/g;
  234.         $string = char_convert($string, 1);
  235.         $string =~ s/&#$1;/\\char\{$1\}/g;
  236.     }
  237.     if ($escaped) {
  238.         $string =~ s/&/&/g;
  239.         $string =~ s/</</g;
  240.         $string =~ s/>/>/g;
  241.         $string =~ s/"/"/g;
  242.     }
  243.     return $string;
  244. }
  245.  
  246. sub find_inner {
  247.     my ($string, $rexp) = @_;
  248.     my $rexpnew = $rexp;
  249.     $rexpnew =~ s/\\(\d+)/join("", "\\", 2+$1)/ge;
  250.     $string =~ /(.*)($rexpnew)/is;
  251.     my $bef = join("", $`, $1);
  252.     my $str = $2;
  253.     my $aft = $';
  254.  
  255.     my @i = $str =~ /$rexp/is;
  256.     $bef .= $`; $aft = join("", $', $aft);
  257.     my $mat = $&;
  258.  
  259.     return ($bef, $aft, $mat, \@i);
  260. }
  261.  
  262. ###
  263. ### read_webtags_conf
  264. ###
  265. ### Reads the configuration file for the formatting tags for the purposes of
  266. ### doing inverse conversion of tags.
  267. ###
  268.  
  269. sub read_webtags_conf {
  270.     my ($forcerefresh) = @_;
  271.     return \%{ $PARAMS->{webtags_inverse} } if ! $forcerefresh && defined $PARAMS->{webtags_inverse};
  272.     my $wt = readfile("$DCONF->{admin_dir}/webtags.conf", "read_webtags_conf", { no_lock => 1, no_unlock => 1 });
  273.     my @wt = @{ $wt };
  274.     @wt = grep(/\S/, @wt);
  275.     @wt = grep(!/^\s*#/, @wt);
  276.     my $buf = "";
  277.     my $tags = undef;
  278.     my $order = 0;
  279.     foreach my $line (@wt) {
  280.         $line =~ s/^\s+//; $line =~ s/\s+$//;
  281.         if ($line =~ /\\\s*$/) {
  282.             $buf .= $` . ' ';
  283.             next;
  284.         } else {
  285.             my $j = join("", $buf, $line);
  286.             $buf = ""; $order++;
  287.             my ($context, $tag, $definition) = split(/\s+/, $j, 3);
  288.             next if $context =~ /^\*/;
  289.             chomp $definition;
  290.             my @u = ();
  291.             my @v = ();
  292.             while ($definition =~ /\|(\d+)\|/) {
  293.                 my ($bef, $mat, $aft) = ($`, $1, $');
  294.                 if ($bef =~ /\!esc\($/ && $aft =~ /^\)\!/) {
  295.                     push @v, { num => $mat, esc => 1 };
  296.                     $bef =~ /\!esc\($/; push @u, $`;
  297.                     $aft =~ /^\)\!/; $definition = $';
  298.                 } else {
  299.                     push @v, { num => $mat, esc => 0 };
  300.                     push @u, $bef;
  301.                     $definition = $aft;
  302.                 }
  303.             }
  304.             push @u, $definition;
  305.             my $rexp = ""; my $ctr = 0;
  306.             my $taken = {};
  307.             if (scalar(@v)) {
  308.                 while (scalar(@u) + scalar(@v)) {
  309.                     my $U = quotemeta(shift @u);
  310.                     my $V = shift @v;
  311.                     while ($U =~ m|\\!VAR\\\((\w+)\\\)\\!|i) {
  312.                         $U = join("", $`, $PARAMS->{$1}, $') if defined $PARAMS->{$1};
  313.                         $U = join("", $`, $DCONF->{$1}, $') if defined $DCONF->{$1};
  314.                         $U = join("", $`, ".*?", $') if !(defined($PARAMS->{$1}) || defined($DCONF->{$1}));
  315.                     }
  316.                     $rexp .= $U;
  317.                     next if $V->{num} == 0;
  318.                     if ($taken->{$V->{num}}->{num}) {
  319.                         $V->{esc} = $taken->{$V->{num}}->{esc};
  320. #                        $rexp .= '.*?';
  321.                         $rexp .= $V->{esc} ? '.*?' : "\\$taken->{$V->{num}}->{num}";
  322.                     } else {
  323.                         $ctr++;
  324.                         $taken->{$V->{num}}->{num} = $ctr;
  325.                         $taken->{$V->{num}}->{esc} = $V->{esc};
  326.                         $rexp .= $V->{esc} ? '([\w\%\+]*?)' : "(.*?)";
  327.                     }
  328.                 }
  329.             } else {
  330.                 $rexp = quotemeta($definition);
  331.             }
  332.             $rexp =~ s/\\\s/\\s\*/g;
  333.             $tag = "**$tag" if $context eq 'c';
  334.             push @{ $tags->{tags}->{$tag} }, { rexp => $rexp, lookup => $taken };
  335.             $tags->{args}->{$tag} = $ctr;
  336.             $tags->{cont}->{$tag} = $context;
  337.             $tags->{order}->{$tag} = $order;
  338.         }
  339.     }
  340.     $PARAMS->{webtags_inverse} = $tags;
  341.     return $tags;
  342. }
  343.  
  344. ###
  345. ### read_tags
  346. ###
  347. ### Reads formatting tags for the purpose of the "webtags" subroutine
  348. ###
  349.  
  350. sub read_tags {
  351.     my ($cont_code, $is_moderator, $is_superuser, $topic_number, $force_refresh) = @_;
  352.     undef my %char;
  353.     undef my %tags;
  354.     undef my $cont;
  355.     undef my $code;
  356.     undef my $act;
  357.     my $noactive = {};
  358.     my $wtc = defined $PARAMS->{webtags_conf} ? $PARAMS->{webtags_conf} : readfile("$DCONF->{admin_dir}/webtags.conf", "read_tags", { no_lock => 1, no_unlock => 1 });
  359.     $PARAMS->{webtags_conf} = $wtc;
  360.     my @wtc = @{ $wtc };
  361.     my $evaltag;
  362.     my $str = "";
  363.     foreach $_ (@wtc) {
  364.         next if /^#/ || ! /\S/;
  365.         $_ = join("", $str, $_);
  366.         $_ = trim($_);
  367.         if (($evaltag, $cont, $code, $act) = m|^(\*?)([cC0-9sSmM]\*?)\s*(\S+)\s*(.*)|) {
  368.             if ($act =~ m|\\$|) { $str .= join("", $evaltag, $cont, " ", $code, " ", $`); next; }
  369.             $str = "";
  370.             $code = char_convert(lc($code));
  371.             $cont = $` if $cont =~ /\*$/;
  372.             if ($cont =~ m|^[cC]|) {
  373.                 $char{$code} = $act;
  374.             } elsif ($cont > $cont_code || (($is_moderator || $is_superuser) && $cont != 1) || ($is_moderator && $cont =~ m|^[mM]|) || ($is_superuser && $cont =~ m|^[sS]|)) {
  375.                 next if ($cont == 1 && $GLOBAL_OPTIONS->{'images'} == 0 && $GLOBAL_OPTIONS->{'options_used'} == 1);
  376.                 next if $code eq "attach" && !$DCONF->{pro};
  377.                 next if ($cont =~ m|^[mM]| && !$is_moderator);
  378.                 next if ($cont =~ m|^[sS]| && !$is_superuser);
  379.                 my $str_ = $act;
  380.                 while ($str_ =~ m|!VAR\((\w+)\)!|i) {
  381.                     $str_ = join("", $`, $PARAMS->{$1}, $') if defined $PARAMS->{$1};
  382.                     $str_ = join("", $`, $DCONF->{$1}, $') if defined $DCONF->{$1};
  383.                     $str_ = join("", $`, $') if !(defined($PARAMS->{$1}) || defined($DCONF->{$1}));
  384.                     $str_ = join("", $`, $topic_number, $') if $1 eq "topic_number" && $topic_number != 0;
  385.                 }
  386.                 $tags{$code} = join("", $evaltag ? "\r" : "", $str_);
  387.             }
  388.         } else {
  389.             $str = "";
  390.         }
  391.     }
  392.     $PARAMS->{webtags_tags} = \%tags;
  393.     $PARAMS->{webtags_chars} = \%char;
  394.     return ($PARAMS->{webtags_tags}, $PARAMS->{webtags_chars});
  395. }
  396.  
  397. ###
  398. ### transit
  399. ###
  400. ### Transforms special tags, like tables and lists, with their special formatting
  401. ### properties.
  402. ###
  403.  
  404. sub transit {
  405.     my ($string, $type) = @_;
  406.     if ($type <= 4) {
  407.         if ($string =~ /[^\\],/) {
  408.             $string =~ s%</TD><TD>%\t%gi;
  409.         } else {
  410.             $string =~ s%</TD><TD>%,%gi;
  411.         }
  412.         $string =~ s%\s?</TD></TR><TR><TD>%\n%gi;
  413.     } elsif ($type >= 5) {
  414.         $string =~ s%\s?<LI>%\n%gi;
  415.     }
  416.     return $string;
  417. }
  418.  
  419. ###
  420. ### parse
  421. ###
  422. ### Internal parser for incoming formatting tags
  423. ###
  424.  
  425. sub parse {
  426.     my ($messages, $text_in, $tags, $char) = @_;
  427.     return ("!Error", $text_in) if $messages eq "!Error";
  428.     my ($v1, $v2, $v3, $v4, $v5, $v6, $v7, $match);
  429.     while ($text_in =~ m|\\([^\{\s]*)\{|) {
  430.         ($v1, $v2, $v3, $match) = ($`, case_lower($1), $', $&);
  431.         ($v4, $v3) = &parse($messages, $v3, $tags, $char);
  432.         return ($v4, $v3) if $v4 eq "!Error";
  433.         $messages .= $v4;
  434.         if ($v3 =~ m|^([^\}]*)\}|) {
  435.             ($v6, $v7) = ($1, $');
  436.         } else {
  437.             my $ncb = read_language()->{NOCLOSINGBRACE};
  438.             $ncb =~ s/\%code/$v2/g;
  439.             return ("!Error", "$ncb");
  440.         }
  441.         $v2 = case_lower($v2);
  442.         if ($v2 eq "ch" && $char->{lc($v6)} ne "") {
  443.             $text_in = join("", $v1, $char->{lc($v6)}, $v7);
  444.         } elsif ($v2 eq "ch") {
  445.             my $sc = read_language()->{NOSPECIALCHARACTER};
  446.             $sc =~ s/\%char/$v6/g;
  447.             return ("!Error", "$sc");
  448.         } elsif (defined($tags->{$v2})) {
  449.             my $temp = $tags->{$v2};
  450.             my $maxtest = 0;
  451.             if ($temp =~ m%\|(\d+)\|%) {
  452.                 while ($temp =~ m%\|(\d+)\|%g) {
  453.                     $maxtest = $1 if $1 > $maxtest;
  454.                 }
  455.             }
  456.             my @splits = ();
  457.             @splits = split(/,/, $v6, $maxtest) if $maxtest > 0;
  458.             my $sc = scalar(@splits);
  459.             if ($sc < $maxtest) {
  460.                 my $wnarg = read_language()->{WRONGNUMBEROFARGUMENTS};
  461.                 $wnarg =~ s/\%code/$v2/g;
  462.                 $wnarg =~ s/\%required/$maxtest/g;
  463.                 $wnarg =~ s/\%your/$sc/g;
  464.                 return ("!Error", "$wnarg");
  465.             }
  466.             if ($temp =~ /^\r/) {
  467.                 $temp = $';
  468.                 $PARAMS->{specialwebtags}++;
  469.                 my $tagone = $GLOBAL_OPTIONS->{special2_in_subjects} ? "" : "-";
  470.                 my $tagtwo = $GLOBAL_OPTIONS->{special2_in_subjects} ? "!" : "-";
  471.                 if ($temp =~ /^&(\w+)\s*\((.*?)\)/) {
  472.                     my ($subname, $inner) = ($1, $2);
  473.                     my @args = ();
  474.                     my @spl = split(/,/, $inner);
  475.                     foreach my $inner (@spl) {
  476.                         my $text = "";
  477.                         while ($inner =~ m%\|(\d+)\|%) {
  478.                             $text .= join("", $`, $splits[($1)-1]);
  479.                             $inner = $';
  480.                         }
  481.                         push @args, join("", $text, $inner);
  482.                     }
  483.                     dreq("webtags2");
  484.                     $temp = join("", "<!-$tagone*$PARAMS->{specialwebtags}-$tagtwo>", &{ \&{$subname} }(@args), "<!-$tagone/*$PARAMS->{specialwebtags}-$tagtwo>");
  485.                     $temp .= join("", "<!-$tagone*$PARAMS->{specialwebtags}:", escape(join("", $match, $v6, "}")), "-$tagtwo>");
  486.                 } else {
  487.                     while ($temp =~ m%!esc\(\|(\d+)\|\)\!%) {
  488.                         $temp = join("", $`, escape($splits[($1)-1]), $');
  489.                     }
  490.                     while ($temp =~ m%\|(\d+)\|%) {
  491.                         $temp = join("", $`, $splits[($1)-1], $');
  492.                     }
  493.                     $temp = join($temp, "<!-$tagone*$PARAMS->{specialwebtags}-$tagtwo>", "<!-$tagone/*$PARAMS->{specialwebtags}-$tagtwo>");
  494.                     $temp .= join("", "<!-$tagone*$PARAMS->{specialwebtags}:", escape(join("", $match, $v6, "}")), "-$tagtwo>");
  495.                 }
  496.                 $text_in = join("", $v1, $temp, $v7);
  497.             } else {
  498.                 if ($v2 eq "link" || $v2 eq "topurl" || $v2 eq "newurl") {
  499.                     if ($GLOBAL_OPTIONS->{'smart_rfc_2141'}) {
  500.                         my $arg = join("", @splits);
  501.                         if ($arg =~ m%^(.*/[\d\,]+\.\w+),((?:.|\n)*?)$%) {
  502.                             $splits[0] = $1;
  503.                             $splits[1] = $2;
  504.                             $splits[0] =~ s/,/\%2C/g;
  505.                         }
  506.                     }
  507.                     $splits[0] =~ s/\,/\%2C/g;
  508. #                    $splits[0] =~ s/\+/\%2B/g;
  509.                     $splits[0] =~ s/\+/\+/g;
  510.                     $splits[0] =~ s/\'/\%27/g;
  511.                     $splits[0] =~ s/ /\%20/g;
  512.                     if ($splits[0] =~ m|[<>]| || $splits[0] =~ m|^\s*javascript:|i) {
  513.                         my $f = read_language()->{NONESTHTML};
  514.                         $f =~ s/\%code/$v2/g;
  515.                         return ("!Error", $f);
  516.                     }
  517.                 }
  518.                 if ($v2 =~ m%^pop(attach|gif|jpeg|png)% || $v2 eq "attach" || $v2 eq read_language()->{ATTACH_TAG_NAME} || $v2 eq "image" || $v2 eq read_language()->{IMAGE_TAG_NAME}) {
  519.                     if ($splits[0] =~ m|[<>]|) {
  520.                         my $f = read_language()->{NONESTHTML};
  521.                         $f =~ s/\%code/$v2/g;
  522.                         return ("!Error", $f);
  523.                     }
  524. #                    $splits[0] =~ s/(^|[^\\]),/$1\\,/g;
  525. #                    $splits[0] =~ s/,//g;
  526.                 }
  527.                 while ($temp =~ m%!esc\(\|(\d+)\|\)\!%) {
  528.                     $temp = join("", $`, escape($splits[($1)-1]), $');
  529.                 }
  530.                 while ($temp =~ m%\|(\d+)\|%) {
  531.                     $temp = join("", $`, $splits[($1)-1], $');
  532.                 }
  533.                 if ($v2 =~ m|^table| || $v2 eq read_language()->{TABLE_TAG} || $v2 eq read_language()->{TABLE_NB_TAG}) {
  534.                     if ($temp =~ m|\t|) {
  535.                         $temp =~ s%\t%</TD><TD>%g;
  536.                     } else {
  537.                         $temp =~ s%,%</TD><TD>%g;
  538.                     }
  539.                     $temp =~ s%<BR>%</TD></TR><TR><TD>%g;
  540.                 } elsif ($v2 eq "list" || $v2 eq read_language()->{LIST_TAG} || $v2 eq "olist" || read_language()->{OLIST_TAG} eq $v2) {
  541.                     $temp =~ s%<BR>%<LI>%g;
  542.                 }
  543.                 $text_in = join("", $v1, $temp, $v7);
  544.             }
  545.         } else {
  546.             my $sc = read_language()->{CODEDOESNOTEXIST};
  547.             $sc =~ s/\%code/$v2/g;
  548.             if ($v2 eq "attach" && !$DCONF->{pro}) {
  549.                 $sc .= "<P>" . read_language()->{FEATURE_NOT_SUPPORTED_DESCR} . "\n";
  550.             }
  551.             return ("!Error", "$sc");
  552.         }
  553.     }
  554.     return ($messages, $text_in);
  555. }
  556.  
  557. 1;
  558.