--- test/html-webhacc/cc.cgi 2008/05/06 07:50:28 1.49 +++ 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[ +
+

Parse Errors

+ +
]; + 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[
], get_error_label ($input, \%opt), + qq[
]; + $type =~ tr/ /-/; + $type =~ s/\|/%7C/g; + $msg .= qq[ [Description]]; + print STDOUT qq[
], get_error_level_label (\%opt); + print STDOUT qq[$msg
\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[
]; + + 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[]; } # print_structure_dump_manifest_section +sub print_structure_dump_webidl_section ($$) { + my ($input, $idl) = @_; + + print STDOUT qq[ +
+

WebIDL

+]; + push @nav, [qq[#$input->{id_prefix}dump-webidl] => 'WebIDL'] + unless $input->{nested}; + + print STDOUT "
";
+  print STDOUT htescape ($idl->idl_text);
+  print STDOUT "
"; + + print STDOUT qq[
]; +} # print_structure_dump_webidl_section + sub print_structure_error_dom_section ($$$$$) { my ($input, $doc, $el, $result, $onsubdoc) = @_; @@ -937,6 +1015,21 @@ print STDOUT qq[]; } # print_structure_error_manifest_section +sub print_structure_error_webidl_section ($$$) { + my ($input, $idl, $result) = @_; + + print STDOUT qq[
+

Document Errors

+ +
]; + push @nav, [qq[#$input->{id_prefix}document-errors] => 'Document Error'] + unless $input->{nested}; + +## TODO: + + print STDOUT qq[
]; +} # print_structure_error_webidl_section + sub print_table_section ($$) { my ($input, $tables) = @_; @@ -956,15 +1049,13 @@ require JSON; my $i = 0; - for my $table_el (@$tables) { + for my $table (@$tables) { $i++; print STDOUT qq[

] . - get_node_link ($input, $table_el) . q[

]; + get_node_link ($input, $table->{element}) . q[]; + + delete $table->{element}; - ## TODO: Make |ContentChecker| return |form_table| result - ## so that this script don't have to run the algorithm twice. - my $table = Whatpm::HTMLTable->form_table ($table_el); - for (@{$table->{column_group}}, @{$table->{column}}, $table->{caption}, @{$table->{row}}) { next unless $_; @@ -1184,24 +1275,25 @@ print STDOUT qq[$label$result->{$_->[1]}->{must}$uncertain$result->{$_->[1]}->{should}$uncertain$result->{$_->[1]}->{warning}$uncertain]; if ($uncertain) { - print qq[−∞..$result->{$_->[1]}->{score_max}]; + print qq[−∞..$result->{$_->[1]}->{score_max}]; } elsif ($result->{$_->[1]}->{score_min} != $result->{$_->[1]}->{score_max}) { - print qq[$result->{$_->[1]}->{score_min}..$result->{$_->[1]}->{score_max}]; + print qq[$result->{$_->[1]}->{score_min}..$result->{$_->[1]}->{score_max}]; } else { - print qq[$result->{$_->[1]}->{score_min}]; + print qq[$result->{$_->[1]}->{score_min}]; } + print qq[ / 20]; } $score_max += $score_base; print STDOUT qq[ -Semantics0?0?0?−∞..$score_base +Semantics0?0?0?−∞..$score_base / 20 Total $must_error? $should_error? $warning? -−∞..$score_max +−∞..$score_max / 100

Important: This conformance checking service @@ -1625,4 +1717,4 @@ =cut -## $Date: 2008/05/06 07:50:28 $ +## $Date: 2008/07/18 14:44:16 $