--- test/html-webhacc/cc.cgi	2008/05/06 08:47:09	1.50
+++ test/html-webhacc/cc.cgi	2008/07/18 14:44:16	1.52
@@ -161,6 +161,7 @@
   my $el;
   my $cssom;
   my $manifest;
+  my $idl;
   my @subdoc;
 
   if ($input->{media_type} eq 'text/html') {
@@ -195,6 +196,10 @@
     $manifest = print_syntax_error_manifest_section ($input, $result);
     print_source_string_section ($input, \($input->{s}),
                                  'utf-8');
+  } elsif ($input->{media_type} eq 'text/x-webidl') { ## TODO: type
+    $idl = print_syntax_error_webidl_section ($input, $result);
+    print_source_string_section ($input, \($input->{s}),
+                                 'utf-8'); ## TODO: charset
   } else {
     ## TODO: Change HTTP status code??
     print_result_unknown_type_section ($input, $result);
@@ -227,6 +232,9 @@
   } elsif (defined $manifest) {
     print_structure_dump_manifest_section ($input, $manifest);
     print_structure_error_manifest_section ($input, $manifest, $result);
+  } elsif (defined $idl) {
+    print_structure_dump_webidl_section ($input, $idl);
+    print_structure_error_webidl_section ($input, $idl, $result);
   }
 
   my $id_prefix = 0;
@@ -673,15 +681,68 @@
   return $manifest;
 } # print_syntax_error_manifest_section
 
+sub print_syntax_error_webidl_section ($$) {
+  my ($input, $result) = @_;
+
+  require Whatpm::WebIDL;
+
+  print STDOUT qq[
+<div id="$input->{id_prefix}parse-errors" class="section">
+<h2>Parse Errors</h2>
+
+<dl id="$input->{id_prefix}parse-errors-list">];
+  push @nav, ['#parse-errors' => 'Parse Error'] unless $input->{nested};
+
+  my $onerror = sub {
+    my (%opt) = @_;
+    my ($type, $cls, $msg) = get_text ($opt{type}, $opt{level});
+    print STDOUT qq[<dt class="$cls">], get_error_label ($input, \%opt),
+        qq[</dt>];
+    $type =~ tr/ /-/;
+    $type =~ s/\|/%7C/g;
+    $msg .= qq[ [<a href="../error-description#@{[htescape ($type)]}">Description</a>]];
+    print STDOUT qq[<dd class="$cls">], get_error_level_label (\%opt);
+    print STDOUT qq[$msg</dd>\n];
+
+    add_error ('syntax', \%opt => $result);
+  };
+
+  require Encode;
+  my $s = $input->{is_char_string} ? $input->{s} : Encode::decode ($input->{charset} || 'utf-8', $input->{s}); ## TODO: charset
+  my $parser = Whatpm::WebIDL::Parser->new;
+  my $idl = $parser->parse_char_string ($input->{s}, $onerror);
+
+  print STDOUT qq[</dl></div>];
+
+  return $idl;
+} # print_syntax_error_webidl_section
+
 sub print_source_string_section ($$$) {
   my $input = shift;
   my $s;
   unless ($input->{is_char_string}) {
-    require Encode;
-    my $enc = Encode::find_encoding ($_[1]); ## TODO: charset name -> Perl name
-    return unless $enc;
+    open my $byte_stream, '<', $_[0];
+    require Message::Charset::Info;
+    my $charset = Message::Charset::Info->get_by_iana_name ($_[1]);
+    my ($char_stream, $e_status) = $charset->get_decode_handle
+        ($byte_stream, allow_error_reporting => 1, allow_fallback => 1);
+    return unless $char_stream;
+
+    $char_stream->onerror (sub {
+      my (undef, $type, %opt) = @_;
+      if ($opt{octets}) {
+        ${$opt{octets}} = "\x{FFFD}";
+      }
+    });
 
-    $s = \($enc->decode (${$_[0]}));
+    my $t = '';
+    while (1) {
+      my $c = $char_stream->getc;
+      last unless defined $c;
+      $t .= $c;
+    }
+    $s = \$t;
+    ## TODO: Output for each line, don't concat all of lines.
   } else {
     $s = $_[0];
   }
@@ -870,6 +931,23 @@
   print STDOUT qq[</dl></div>];
 } # print_structure_dump_manifest_section
 
+sub print_structure_dump_webidl_section ($$) {
+  my ($input, $idl) = @_;
+
+  print STDOUT qq[
+<div id="$input->{id_prefix}dump-webidl" class="section">
+<h2>WebIDL</h2>
+];
+  push @nav, [qq[#$input->{id_prefix}dump-webidl] => 'WebIDL']
+      unless $input->{nested};
+
+  print STDOUT "<pre>";
+  print STDOUT htescape ($idl->idl_text);
+  print STDOUT "</pre>";
+
+  print STDOUT qq[</div>];
+} # print_structure_dump_webidl_section
+
 sub print_structure_error_dom_section ($$$$$) {
   my ($input, $doc, $el, $result, $onsubdoc) = @_;
 
@@ -937,6 +1015,21 @@
   print STDOUT qq[</div>];
 } # print_structure_error_manifest_section
 
+sub print_structure_error_webidl_section ($$$) {
+  my ($input, $idl, $result) = @_;
+
+  print STDOUT qq[<div id="$input->{id_prefix}document-errors" class="section">
+<h2>Document Errors</h2>
+
+<dl>];
+  push @nav, [qq[#$input->{id_prefix}document-errors] => 'Document Error']
+      unless $input->{nested};
+
+## TODO:
+
+  print STDOUT qq[</div>];
+} # print_structure_error_webidl_section
+
 sub print_table_section ($$) {
   my ($input, $tables) = @_;
   
@@ -1182,24 +1275,25 @@
 
     print STDOUT qq[<tr class="@{[$uncertain ? 'uncertain' : '']}"><th scope=row>$label</th><td class="@{[$result->{$_->[1]}->{must} ? 'FAIL' : '']}">$result->{$_->[1]}->{must}$uncertain</td><td class="@{[$result->{$_->[1]}->{should} ? 'SEE-RESULT' : '']}">$result->{$_->[1]}->{should}$uncertain</td><td>$result->{$_->[1]}->{warning}$uncertain</td>];
     if ($uncertain) {
-      print qq[<td class="@{[$result->{$_->[1]}->{must} ? 'FAIL' : $result->{$_->[1]}->{should} ? 'SEE-RESULT' : '']}">&#x2212;&#x221E;..$result->{$_->[1]}->{score_max}</td>];
+      print qq[<td class="@{[$result->{$_->[1]}->{must} ? 'FAIL' : $result->{$_->[1]}->{should} ? 'SEE-RESULT' : '']}">&#x2212;&#x221E;..$result->{$_->[1]}->{score_max}];
     } elsif ($result->{$_->[1]}->{score_min} != $result->{$_->[1]}->{score_max}) {
-      print qq[<td class="@{[$result->{$_->[1]}->{must} ? 'FAIL' : 'SEE-RESULT']}">$result->{$_->[1]}->{score_min}..$result->{$_->[1]}->{score_max}</td></tr>];
+      print qq[<td class="@{[$result->{$_->[1]}->{must} ? 'FAIL' : 'SEE-RESULT']}">$result->{$_->[1]}->{score_min}..$result->{$_->[1]}->{score_max}];
     } else {
-      print qq[<td class="@{[$result->{$_->[1]}->{must} ? 'FAIL' : '']}">$result->{$_->[1]}->{score_min}</td></tr>];
+      print qq[<td class="@{[$result->{$_->[1]}->{must} ? 'FAIL' : '']}">$result->{$_->[1]}->{score_min}];
     }
+    print qq[ / 20];
   }
 
   $score_max += $score_base;
 
   print STDOUT qq[
-<tr class=uncertain><th scope=row>Semantics</th><td>0?</td><td>0?</td><td>0?</td><td>&#x2212;&#x221E;..$score_base</td></tr>
+<tr class=uncertain><th scope=row>Semantics</th><td>0?</td><td>0?</td><td>0?</td><td>&#x2212;&#x221E;..$score_base / 20
 </tbody>
 <tfoot><tr class=uncertain><th scope=row>Total</th>
 <td class="@{[$must_error ? 'FAIL' : '']}">$must_error?</td>
 <td class="@{[$should_error ? 'SEE-RESULT' : '']}">$should_error?</td>
 <td>$warning?</td>
-<td class="@{[$must_error ? 'FAIL' : $should_error ? 'SEE-RESULT' : '']}"><strong>&#x2212;&#x221E;..$score_max</strong></td></tr></tfoot>
+<td class="@{[$must_error ? 'FAIL' : $should_error ? 'SEE-RESULT' : '']}"><strong>&#x2212;&#x221E;..$score_max</strong> / 100
 </table>
 
 <p><strong>Important</strong>: This conformance checking service
@@ -1623,4 +1717,4 @@
 
 =cut
 
-## $Date: 2008/05/06 08:47:09 $
+## $Date: 2008/07/18 14:44:16 $