--- test/html-webhacc/cc.cgi 2007/11/23 12:08:32 1.29 +++ test/html-webhacc/cc.cgi 2008/02/10 02:42:01 1.33 @@ -89,47 +89,7 @@ ]; my $result = {conforming_min => 1, conforming_max => 1}; - print_http_header_section ($input, $result); - - my $doc; - my $el; - my $manifest; - - if ($input->{media_type} eq 'text/html') { - ($doc, $el) = print_syntax_error_html_section ($input, $result); - print_source_string_section - (\($input->{s}), $input->{charset} || $doc->input_encoding); - } elsif ({ - 'text/xml' => 1, - 'application/atom+xml' => 1, - 'application/rss+xml' => 1, - 'application/svg+xml' => 1, - 'application/xhtml+xml' => 1, - 'application/xml' => 1, - }->{$input->{media_type}}) { - ($doc, $el) = print_syntax_error_xml_section ($input, $result); - print_source_string_section (\($input->{s}), $doc->input_encoding); - } elsif ($input->{media_type} eq 'text/cache-manifest') { -## TODO: MUST be text/cache-manifest - $manifest = print_syntax_error_manifest_section ($input, $result); - print_source_string_section (\($input->{s}), 'utf-8'); - } else { - ## TODO: Change HTTP status code?? - print_result_unknown_type_section ($input, $result); - } - - if (defined $doc or defined $el) { - print_structure_dump_dom_section ($doc, $el); - my $elements = print_structure_error_dom_section ($doc, $el, $result); - print_table_section ($elements->{table}) if @{$elements->{table}}; - print_id_section ($elements->{id}) if keys %{$elements->{id}}; - print_term_section ($elements->{term}) if keys %{$elements->{term}}; - print_class_section ($elements->{class}) if keys %{$elements->{class}}; - } elsif (defined $manifest) { - print_structure_dump_manifest_section ($manifest); - print_structure_error_manifest_section ($manifest, $result); - } - + check_and_print ($input => $result); print_result_section ($result); } else { print STDOUT qq[]; @@ -166,7 +126,7 @@ $result->{conforming_min} = 0; } elsif ($err->{level} eq 'w' or $err->{level} eq 'g') { $result->{$layer}->{warning}++; - } elsif ($err->{level} eq 'unsupported') { + } elsif ($err->{level} eq 'u' or $err->{level} eq 'unsupported') { $result->{$layer}->{unsupported}++; $result->{unsupported} = 1; } else { @@ -185,14 +145,68 @@ } } # add_error +sub check_and_print ($$) { + my ($input, $result) = @_; + $input->{id_prefix} = ''; + #$input->{nested} = 1/0; + + print_http_header_section ($input, $result); + + my $doc; + my $el; + my $manifest; + + if ($input->{media_type} eq 'text/html') { + ($doc, $el) = print_syntax_error_html_section ($input, $result); + print_source_string_section + (\($input->{s}), $input->{charset} || $doc->input_encoding); + } elsif ({ + 'text/xml' => 1, + 'application/atom+xml' => 1, + 'application/rss+xml' => 1, + 'application/svg+xml' => 1, + 'application/xhtml+xml' => 1, + 'application/xml' => 1, + }->{$input->{media_type}}) { + ($doc, $el) = print_syntax_error_xml_section ($input, $result); + print_source_string_section (\($input->{s}), $doc->input_encoding); + } elsif ($input->{media_type} eq 'text/cache-manifest') { +## TODO: MUST be text/cache-manifest + $manifest = print_syntax_error_manifest_section ($input, $result); + print_source_string_section (\($input->{s}), 'utf-8'); + } else { + ## TODO: Change HTTP status code?? + print_result_unknown_type_section ($input, $result); + } + + if (defined $doc or defined $el) { + print_structure_dump_dom_section ($input, $doc, $el); + my $elements = print_structure_error_dom_section + ($input, $doc, $el, $result); + print_table_section ($input, $elements->{table}) if @{$elements->{table}}; + print_listing_section ({ + id => 'identifiers', label => 'IDs', heading => 'Identifiers', + }, $input, $elements->{id}) if keys %{$elements->{id}}; + print_listing_section ({ + id => 'terms', label => 'Terms', heading => 'Terms', + }, $input, $elements->{term}) if keys %{$elements->{term}}; + print_listing_section ({ + id => 'classes', label => 'Classes', heading => 'Classes', + }, $input, $elements->{class}) if keys %{$elements->{class}}; + } elsif (defined $manifest) { + print_structure_dump_manifest_section ($input, $manifest); + print_structure_error_manifest_section ($input, $manifest, $result); + } +} # check_and_print + sub print_http_header_section ($$) { my ($input, $result) = @_; return unless defined $input->{header_status_code} or defined $input->{header_status_text} or @{$input->{header_field}}; - push @nav, ['#source-header' => 'HTTP Header']; - print STDOUT qq[
+ push @nav, ['#source-header' => 'HTTP Header'] unless $input->{nested}; + print STDOUT qq[

HTTP Header

Note: Due to the limitation of the @@ -226,11 +240,11 @@ require Whatpm::HTML; print STDOUT qq[ -

+

Parse Errors

]; - push @nav, ['#parse-errors' => 'Parse Error']; + push @nav, ['#parse-errors' => 'Parse Error'] unless $input->{nested}; my $onerror = sub { my (%opt) = @_; @@ -284,11 +298,11 @@ require Message::DOM::XMLParserTemp; print STDOUT qq[ -
+

Parse Errors

]; - push @nav, ['#parse-errors' => 'Parse Error']; + push @nav, ['#parse-errors' => 'Parse Error'] unless $input->{prefix}; my $onerror = sub { my $err = shift; @@ -326,16 +340,17 @@ require Whatpm::CacheManifest; print STDOUT qq[ -
+

Parse Errors

]; - push @nav, ['#parse-errors' => 'Parse Error']; + 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 (\%opt), qq[
]; + print STDOUT qq[
], get_error_label ($input, \%opt), + qq[
]; $type =~ tr/ /-/; $type =~ s/\|/%7C/g; $msg .= qq[ [Description]]; @@ -362,20 +377,22 @@ my $s = \($enc->decode (${$_[0]})); my $i = 1; - push @nav, ['#source-string' => 'Source']; - print STDOUT qq[
+ push @nav, ['#source-string' => 'Source'] unless $input->{nested}; + print STDOUT qq[

Document Source

    \n]; if (length $$s) { while ($$s =~ /\G([^\x0A]*?)\x0D?\x0A/gc) { - print STDOUT qq[
  1. ], htescape $1, "
  2. \n"; + print STDOUT qq[
  3. ], htescape $1, + "
  4. \n"; $i++; } if ($$s =~ /\G([^\x0A]+)/gc) { - print STDOUT qq[
  5. ], htescape $1, "
  6. \n"; + print STDOUT qq[
  7. ], htescape $1, + "
  8. \n"; } } else { - print STDOUT q[
  9. ]; + print STDOUT q[
  10. ]; } print STDOUT "
"; } # print_input_string_section @@ -392,7 +409,7 @@ next; } - my $node_id = 'node-'.refaddr $child; + my $node_id = $input->{id_prefix} . 'node-'.refaddr $child; my $nt = $child->node_type; if ($nt == $child->ELEMENT_NODE) { my $child_nsuri = $child->namespace_uri; @@ -403,7 +420,7 @@ $r .= '
    '; for my $attr (sort {$a->[0] cmp $b->[0]} map { [$_->name, $_->value, $_->namespace_uri, 'node-'.refaddr $_] } @{$child->attributes}) { - $r .= qq[
  • ] . htescape ($attr->[0]) . ' = '; ## ISSUE: case? + $r .= qq[
  • ] . htescape ($attr->[0]) . ' = '; ## ISSUE: case? $r .= '' . htescape ($attr->[1]) . '
  • '; ## TODO: children } $r .= '
'; @@ -472,28 +489,28 @@ print STDOUT $r; } # print_document_tree -sub print_structure_dump_dom_section ($$) { - my ($doc, $el) = @_; +sub print_structure_dump_dom_section ($$$) { + my ($input, $doc, $el) = @_; print STDOUT qq[ -
+

Document Tree

]; - push @nav, ['#document-tree' => 'Tree']; + push @nav, ['#document-tree' => 'Tree'] unless $input->{nested}; print_document_tree ($el || $doc); print STDOUT qq[
]; } # print_structure_dump_dom_section -sub print_structure_dump_manifest_section ($) { - my $manifest = shift; +sub print_structure_dump_manifest_section ($$) { + my ($input, $manifest) = @_; print STDOUT qq[ -
+

Cache Manifest

]; - push @nav, ['#dump-manifest' => 'Caceh Manifest']; + push @nav, ['#dump-manifest' => 'Caceh Manifest'] unless $input->{nested}; print STDOUT qq[
Explicit entries
]; for my $uri (@{$manifest->[0]}) { @@ -520,14 +537,14 @@ print STDOUT qq[
]; } # print_structure_dump_manifest_section -sub print_structure_error_dom_section ($$$) { - my ($doc, $el, $result) = @_; +sub print_structure_error_dom_section ($$$$) { + my ($input, $doc, $el, $result) = @_; - print STDOUT qq[
+ print STDOUT qq[

Document Errors

]; - push @nav, ['#document-errors' => 'Document Error']; + push @nav, ['#document-errors' => 'Document Error'] unless $input->{nested}; require Whatpm::ContentChecker; my $onerror = sub { @@ -536,7 +553,7 @@ $type =~ tr/ /-/; $type =~ s/\|/%7C/g; $msg .= qq[ [Description]]; - print STDOUT qq[
] . get_error_label (\%opt) . + print STDOUT qq[
] . get_error_label ($input, \%opt) . qq[
\n
], get_error_level_label (\%opt); print STDOUT $msg, "
\n"; add_error ('structure', \%opt => $result); @@ -557,13 +574,13 @@ } # print_structure_error_dom_section sub print_structure_error_manifest_section ($$$) { - my ($manifest, $result) = @_; + my ($input, $manifest, $result) = @_; - print STDOUT qq[
+ print STDOUT qq[

Document Errors

]; - push @nav, ['#document-errors' => 'Document Error']; + push @nav, ['#document-errors' => 'Document Error'] unless $input->{nested}; require Whatpm::CacheManifest; Whatpm::CacheManifest->check_manifest ($manifest, sub { @@ -572,7 +589,7 @@ $type =~ tr/ /-/; $type =~ s/\|/%7C/g; $msg .= qq[ [Description]]; - print STDOUT qq[
] . get_error_label (\%opt) . + print STDOUT qq[
] . get_error_label ($input, \%opt) . qq[
\n
], $msg, "
\n"; add_error ('structure', \%opt => $result); }); @@ -580,12 +597,12 @@ print STDOUT qq[
]; } # print_structure_error_manifest_section -sub print_table_section ($) { - my $tables = shift; +sub print_table_section ($$) { + my ($input, $tables) = @_; - push @nav, ['#tables' => 'Tables']; + push @nav, ['#tables' => 'Tables'] unless $input->{nested}; print STDOUT qq[ -
+

Tables

@@ -600,8 +617,8 @@ my $i = 0; for my $table_el (@$tables) { $i++; - print STDOUT qq[

] . - get_node_link ($table_el) . q[

]; + print STDOUT qq[

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

]; ## TODO: Make |ContentChecker| return |form_table| result ## so that this script don't have to run the algorithm twice. @@ -633,68 +650,31 @@ print STDOUT '
]; + print STDOUT qq[, document.getElementById ('$input->{id_prefix}table-$i')]; + print STDOUT qq[, '$input->{id_prefix}');]; } print STDOUT qq[
]; } # print_table_section -sub print_id_section ($) { - my $ids = shift; +sub print_listing_section ($$$) { + my ($opt, $input, $ids) = @_; - push @nav, ['#identifiers' => 'IDs']; + push @nav, ['#' . $opt->{id} => $opt->{label}] unless $input->{nested}; print STDOUT qq[ -
-

Identifiers

+
+

$opt->{heading}

]; for my $id (sort {$a cmp $b} keys %$ids) { print STDOUT qq[
@{[htescape $id]}
]; for (@{$ids->{$id}}) { - print STDOUT qq[
].get_node_link ($_).qq[
]; - } - } - print STDOUT qq[
]; -} # print_id_section - -sub print_term_section ($) { - my $terms = shift; - - push @nav, ['#terms' => 'Terms']; - print STDOUT qq[ -
-

Terms

- -
-]; - for my $term (sort {$a cmp $b} keys %$terms) { - print STDOUT qq[
@{[htescape $term]}
]; - for (@{$terms->{$term}}) { - print STDOUT qq[
].get_node_link ($_).qq[
]; + print STDOUT qq[
].get_node_link ($input, $_).qq[
]; } } print STDOUT qq[
]; -} # print_term_section - -sub print_class_section ($) { - my $classes = shift; - - push @nav, ['#classes' => 'Classes']; - print STDOUT qq[ -
-

Classes

- -
-]; - for my $class (sort {$a cmp $b} keys %$classes) { - print STDOUT qq[
@{[htescape $class]}
]; - for (@{$classes->{$class}}) { - print STDOUT qq[
].get_node_link ($_).qq[
]; - } - } - print STDOUT qq[
]; -} # print_class_section +} # print_listing_section sub print_result_section ($) { my $result = shift; @@ -806,9 +786,9 @@
]; push @nav, ['#parse-errors' => 'Errors']; - add_error (char => {level => 'unsupported'} => $result); - add_error (syntax => {level => 'unsupported'} => $result); - add_error (structure => {level => 'unsupported'} => $result); + add_error (char => {level => 'u'} => $result); + add_error (syntax => {level => 'u'} => $result); + add_error (structure => {level => 'u'} => $result); } # print_result_unknown_type_section sub print_result_input_error_section ($) { @@ -817,10 +797,10 @@

Input Error: @{[htescape ($input->{error_status_text})]}

]; push @nav, ['#result-summary' => 'Result']; -} # print_Result_input_error_section +} # print_result_input_error_section -sub get_error_label ($) { - my $err = shift; +sub get_error_label ($$) { + my ($input, $err) = @_; my $r = ''; @@ -835,7 +815,7 @@ if (defined $err->{node}) { $r .= ' ' if length $r; - $r = get_node_link ($err->{node}); + $r = get_node_link ($input, $err->{node}); } if (defined $err->{index}) { @@ -865,7 +845,7 @@ } elsif ($err->{level} eq 'w') { $r = qq[Warning: ]; - } elsif ($err->{level} eq 'unsupported') { + } elsif ($err->{level} eq 'u' or $err->{level} eq 'unsupported') { $r = qq[Not supported: ]; } else { @@ -904,9 +884,9 @@ return join '/', @r; } # get_node_path -sub get_node_link ($) { - return qq[] . - htescape (get_node_path ($_[0])) . qq[]; +sub get_node_link ($$) { + return qq[] . + htescape (get_node_path ($_[1])) . qq[]; } # get_node_link { @@ -1151,4 +1131,4 @@ =cut -## $Date: 2007/11/23 12:08:32 $ +## $Date: 2008/02/10 02:42:01 $