/[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.9 by wakaba, Sun Jul 15 16:39:10 2007 UTC revision 1.13 by wakaba, Tue Jul 17 13:52:54 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 46  my $http = SuikaWiki::Input::HTTP->new; Line 50  my $http = SuikaWiki::Input::HTTP->new;
50  <link rel="stylesheet" href="../cc-style.css" type="text/css">  <link rel="stylesheet" href="../cc-style.css" type="text/css">
51  </head>  </head>
52  <body>  <body>
53  <h1>Web Document Conformance Checker (<em>beta</em>)</h1>  <h1><a href="../cc-interface">Web Document Conformance Checker</a>
54    (<em>beta</em>)</h1>
55    
56  <div id="document-info" class="section">  <div id="document-info" class="section">
57  <dl>  <dl>
# Line 80  if (defined $input->{s}) { Line 85  if (defined $input->{s}) {
85    if ($input->{media_type} eq 'text/html') {    if ($input->{media_type} eq 'text/html') {
86      require Encode;      require Encode;
87      require Whatpm::HTML;      require Whatpm::HTML;
88    
89        $input->{charset} ||= 'ISO-8859-1'; ## TODO: for now.
90            
91      my $t = Encode::decode ($input->{charset}, $input->{s});      my $t = Encode::decode ($input->{charset}, $input->{s});
92    
# Line 87  if (defined $input->{s}) { Line 94  if (defined $input->{s}) {
94  <div id="parse-errors" class="section">  <div id="parse-errors" class="section">
95  <h2>Parse Errors</h2>  <h2>Parse Errors</h2>
96    
97  <dl>  <dl>];
 ];  
98    push @nav, ['#parse-errors' => 'Parse Error'];    push @nav, ['#parse-errors' => 'Parse Error'];
99    
100    my $onerror = sub {    my $onerror = sub {
101      my (%opt) = @_;      my (%opt) = @_;
102      my ($cls, $msg) = get_text ($opt{type}, $opt{level});      my ($type, $cls, $msg) = get_text ($opt{type}, $opt{level});
103      if ($opt{column} > 0) {      if ($opt{column} > 0) {
104        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];
105      } else {      } else {
106        $opt{line} = $opt{line} - 1 || 1;        $opt{line} = $opt{line} - 1 || 1;
107        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];
108      }      }
109      $opt{type} =~ tr/ /-/;      $type =~ tr/ /-/;
110      $opt{type} =~ s/\|/%7C/g;      $type =~ s/\|/%7C/g;
111      $msg .= qq[ [<a href="../error-description#$opt{type}">Description</a>]];      $msg .= qq[ [<a href="../error-description#@{[htescape ($type)]}">Description</a>]];
112      print STDOUT qq[<dd class="$cls">$msg</dd>\n];      print STDOUT qq[<dd class="$cls">$msg</dd>\n];
113    };    };
114    
# Line 115  if (defined $input->{s}) { Line 121  if (defined $input->{s}) {
121      Whatpm::HTML->parse_string ($t => $doc, $onerror);      Whatpm::HTML->parse_string ($t => $doc, $onerror);
122    }    }
123    
124    print STDOUT qq[    print STDOUT qq[</dl>
 </dl>  
125  </div>  </div>
126  ];  ];
127    
# Line 185  if (defined $input->{s}) { Line 190  if (defined $input->{s}) {
190      require Whatpm::ContentChecker;      require Whatpm::ContentChecker;
191      my $onerror = sub {      my $onerror = sub {
192        my %opt = @_;        my %opt = @_;
193        my ($cls, $msg) = get_text ($opt{type}, $opt{level});        my ($type, $cls, $msg) = get_text ($opt{type}, $opt{level});
194        $opt{type} = $opt{level} . ':' . $opt{type} if defined $opt{level};        $type =~ tr/ /-/;
195        $opt{type} =~ tr/ /-/;        $type =~ s/\|/%7C/g;
196        $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>]];  
197        print STDOUT qq[<dt class="$cls">] . get_node_link ($opt{node}) .        print STDOUT qq[<dt class="$cls">] . get_node_link ($opt{node}) .
198            qq[</dt>\n<dd class="$cls">], $msg, "</dd>\n";            qq[</dt>\n<dd class="$cls">], $msg, "</dd>\n";
199      };      };
# Line 224  if (defined $input->{s}) { Line 228  if (defined $input->{s}) {
228          $i++;          $i++;
229          print STDOUT qq[<div class="section" id="table-$i"><h3>] .          print STDOUT qq[<div class="section" id="table-$i"><h3>] .
230              get_node_link ($table_el) . q[</h3>];              get_node_link ($table_el) . q[</h3>];
231            
232            ## TODO: Make |ContentChecker| return |form_table| result
233            ## so that this script don't have to run the algorithm twice.
234          my $table = Whatpm::HTMLTable->form_table ($table_el);          my $table = Whatpm::HTMLTable->form_table ($table_el);
235                    
236          for (@{$table->{column_group}}, @{$table->{column}}, $table->{caption}) {          for (@{$table->{column_group}}, @{$table->{column}}, $table->{caption}) {
# Line 246  if (defined $input->{s}) { Line 252  if (defined $input->{s}) {
252              for (@$_) {              for (@$_) {
253                $_->{id} = refaddr $_->{element} if defined $_->{element};                $_->{id} = refaddr $_->{element} if defined $_->{element};
254                delete $_->{element};                delete $_->{element};
255                  $_->{is_header} = $_->{is_header} ? 1 : 0;
256              }              }
257            }            }
258          }          }
# Line 258  if (defined $input->{s}) { Line 265  if (defined $input->{s}) {
265        print STDOUT qq[</div>];        print STDOUT qq[</div>];
266      }      }
267    
268        if (keys %{$elements->{id}}) {
269          print STDOUT qq[
270    <div id="identifiers" class="section">
271    <h2>Identifiers</h2>
272    
273    <dl>
274    ];
275          for my $id (sort {$a cmp $b} keys %{$elements->{id}}) {
276            print STDOUT qq[<dt>@{[htescape $id]}</dt>];
277            for (@{$elements->{id}->{$id}}) {
278              print STDOUT qq[<dd>].get_node_link ($_).qq[</dd>];
279            }
280          }
281          print STDOUT qq[</dl></div>];
282        }
283    
284      if (keys %{$elements->{term}}) {      if (keys %{$elements->{term}}) {
285        print STDOUT qq[        print STDOUT qq[
286  <div id="terms" class="section">  <div id="terms" class="section">
# Line 493  sub get_text ($) { Line 516  sub get_text ($) {
516    {    {
517      if (defined $Msg->{$type}) {      if (defined $Msg->{$type}) {
518        my $msg = $Msg->{$type}->[1];        my $msg = $Msg->{$type}->[1];
519        $msg =~ s/\$([0-9]+)/defined $arg[$1] ? htescape ($arg[$1]) : '(undef)'/ge;        $msg =~ s{<var>\$([0-9]+)</var>}{
520        return ($Msg->{$type}->[0], $msg);          defined $arg[$1] ? htescape ($arg[$1]) : '(undef)';
521          }ge;
522          return ($type, $Msg->{$type}->[0], $msg);
523      } elsif ($type =~ s/:([^:]*)$//) {      } elsif ($type =~ s/:([^:]*)$//) {
524        unshift @arg, $1;        unshift @arg, $1;
525        redo;        redo;
526      }      }
527    }    }
528    return ('', htescape ($_[0]));    return ($type, '', htescape ($_[0]));
529  } # get_text  } # get_text
530    
531  }  }
Legend:
Removed from v.1.9  
changed lines
  Added in v.1.13
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24