/[pub]/test/html-webhacc/cc.cgi
Suika

Diff of /test/html-webhacc/cc.cgi

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.10 by wakaba, Mon Jul 16 08:38:48 2007 UTC revision 1.12 by wakaba, Mon Jul 16 13:56:26 2007 UTC
# Line 15  sub htescape ($) { Line 15  sub htescape ($) {
15    $s =~ s/</&lt;/g;    $s =~ s/</&lt;/g;
16    $s =~ s/>/&gt;/g;    $s =~ s/>/&gt;/g;
17    $s =~ s/"/&quot;/g;    $s =~ s/"/&quot;/g;
18    $s =~ s!([\x00-\x09\x0B-\x1F\x7F-\x80])!sprintf '<var>U+%04X</var>', ord $1!ge;    $s =~ s{([\x00-\x09\x0B-\x1F\x7F-\xA0\x{FEFF}\x{FFFC}-\x{FFFF}])}{
19        sprintf '<var>U+%04X</var>', ord $1;
20      }ge;
21    return $s;    return $s;
22  } # htescape  } # htescape
23    
# Line 28  my $http = SuikaWiki::Input::HTTP->new; Line 30  my $http = SuikaWiki::Input::HTTP->new;
30      exit;      exit;
31    }    }
32    
33      binmode STDOUT, ':utf8';
34    
35    require Message::DOM::DOMImplementation;    require Message::DOM::DOMImplementation;
36    my $dom = Message::DOM::DOMImplementation->new;    my $dom = Message::DOM::DOMImplementation->new;
37    
# Line 94  if (defined $input->{s}) { Line 98  if (defined $input->{s}) {
98    
99    my $onerror = sub {    my $onerror = sub {
100      my (%opt) = @_;      my (%opt) = @_;
101      my ($cls, $msg) = get_text ($opt{type}, $opt{level});      my ($type, $cls, $msg) = get_text ($opt{type}, $opt{level});
102      if ($opt{column} > 0) {      if ($opt{column} > 0) {
103        print STDOUT qq[<dt class="$cls"><a href="#line-$opt{line}">Line $opt{line}</a> column $opt{column}</dt>\n];        print STDOUT qq[<dt class="$cls"><a href="#line-$opt{line}">Line $opt{line}</a> column $opt{column}</dt>\n];
104      } else {      } else {
105        $opt{line} = $opt{line} - 1 || 1;        $opt{line} = $opt{line} - 1 || 1;
106        print STDOUT qq[<dt class="$cls"><a href="#line-$opt{line}">Line $opt{line}</a></dt>\n];        print STDOUT qq[<dt class="$cls"><a href="#line-$opt{line}">Line $opt{line}</a></dt>\n];
107      }      }
108      $opt{type} =~ tr/ /-/;      $type =~ tr/ /-/;
109      $opt{type} =~ s/\|/%7C/g;      $type =~ s/\|/%7C/g;
110      $msg .= qq[ [<a href="../error-description#$opt{type}">Description</a>]];      $msg .= qq[ [<a href="../error-description#@{[htescape ($type)]}">Description</a>]];
111      print STDOUT qq[<dd class="$cls">$msg</dd>\n];      print STDOUT qq[<dd class="$cls">$msg</dd>\n];
112    };    };
113    
# Line 185  if (defined $input->{s}) { Line 189  if (defined $input->{s}) {
189      require Whatpm::ContentChecker;      require Whatpm::ContentChecker;
190      my $onerror = sub {      my $onerror = sub {
191        my %opt = @_;        my %opt = @_;
192        my ($cls, $msg) = get_text ($opt{type}, $opt{level});        my ($type, $cls, $msg) = get_text ($opt{type}, $opt{level});
193        $opt{type} = $opt{level} . ':' . $opt{type} if defined $opt{level};        $type =~ tr/ /-/;
194        $opt{type} =~ tr/ /-/;        $type =~ s/\|/%7C/g;
195        $opt{type} =~ s/\|/%7C/g;        $msg .= qq[ [<a href="../error-description#@{[htescape ($type)]}">Description</a>]];
       $msg .= qq[ [<a href="../error-description#$opt{type}">Description</a>]];  
196        print STDOUT qq[<dt class="$cls">] . get_node_link ($opt{node}) .        print STDOUT qq[<dt class="$cls">] . get_node_link ($opt{node}) .
197            qq[</dt>\n<dd class="$cls">], $msg, "</dd>\n";            qq[</dt>\n<dd class="$cls">], $msg, "</dd>\n";
198      };      };
# Line 246  if (defined $input->{s}) { Line 249  if (defined $input->{s}) {
249              for (@$_) {              for (@$_) {
250                $_->{id} = refaddr $_->{element} if defined $_->{element};                $_->{id} = refaddr $_->{element} if defined $_->{element};
251                delete $_->{element};                delete $_->{element};
252                  $_->{is_header} = $_->{is_header} ? 1 : 0;
253              }              }
254            }            }
255          }          }
# Line 496  sub get_text ($) { Line 500  sub get_text ($) {
500        $msg =~ s{<var>\$([0-9]+)</var>}{        $msg =~ s{<var>\$([0-9]+)</var>}{
501          defined $arg[$1] ? htescape ($arg[$1]) : '(undef)';          defined $arg[$1] ? htescape ($arg[$1]) : '(undef)';
502        }ge;        }ge;
503        return ($Msg->{$type}->[0], $msg);        return ($type, $Msg->{$type}->[0], $msg);
504      } elsif ($type =~ s/:([^:]*)$//) {      } elsif ($type =~ s/:([^:]*)$//) {
505        unshift @arg, $1;        unshift @arg, $1;
506        redo;        redo;
507      }      }
508    }    }
509    return ('', htescape ($_[0]));    return ($type, '', htescape ($_[0]));
510  } # get_text  } # get_text
511    
512  }  }
Legend:
Removed from v.1.10  
changed lines
  Added in v.1.12
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24