--- test/html-webhacc/cc.cgi 2008/03/21 09:17:45 1.46 +++ test/html-webhacc/cc.cgi 2008/05/06 08:47:09 1.50 @@ -218,6 +218,7 @@ print_listing_section ({ id => 'classes', label => 'Classes', heading => 'Classes', }, $input, $elements->{class}) if keys %{$elements->{class}}; + print_uri_section ($input, $elements->{uri}) if keys %{$elements->{uri}}; print_rdf_section ($input, $elements->{rdf}) if @{$elements->{rdf}}; } elsif (defined $cssom) { print_structure_dump_cssom_section ($input, $cssom); @@ -322,18 +323,25 @@ if (defined $inner_html_element and length $inner_html_element) { $input->{charset} ||= 'windows-1252'; ## TODO: for now. my $time1 = time; - my $t = Encode::decode ($input->{charset}, $input->{s}); + my $t = \($input->{s}); + unless ($input->{is_char_string}) { + $t = \(Encode::decode ($input->{charset}, $$t)); + } $time{decode} = time - $time1; $el = $doc->create_element_ns ('http://www.w3.org/1999/xhtml', [undef, $inner_html_element]); $time1 = time; - Whatpm::HTML->set_inner_html ($el, $t, $onerror); + Whatpm::HTML->set_inner_html ($el, $$t, $onerror); $time{parse} = time - $time1; } else { my $time1 = time; - Whatpm::HTML->parse_byte_string - ($input->{charset}, $input->{s} => $doc, $onerror); + if ($input->{is_char_string}) { + Whatpm::HTML->parse_char_string ($input->{s} => $doc, $onerror); + } else { + Whatpm::HTML->parse_byte_string + ($input->{charset}, $input->{s} => $doc, $onerror); + } $time{parse_html} = time - $time1; } $doc->manakai_charset ($input->{official_charset}) @@ -373,8 +381,15 @@ return 1; }; + my $t = \($input->{s}); + if ($input->{is_char_string}) { + require Encode; + $t = \(Encode::encode ('utf8', $$t)); + $input->{charset} = 'utf-8'; + } + my $time1 = time; - open my $fh, '<', \($input->{s}); + open my $fh, '<', $t; my $doc = Message::DOM::XMLParserTemp->parse_byte_stream ($fh => $dom, $onerror, charset => $input->{charset}); $time{parse_xml} = time - $time1; @@ -647,8 +662,9 @@ add_error ('syntax', \%opt => $result); }; + my $m = $input->{is_char_string} ? 'parse_char_string' : 'parse_byte_string'; my $time1 = time; - my $manifest = Whatpm::CacheManifest->parse_byte_string + my $manifest = Whatpm::CacheManifest->$m ($input->{s}, $input->{uri}, $input->{base_uri}, $onerror); $time{parse_manifest} = time - $time1; @@ -940,16 +956,15 @@ 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[]; - ## 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}) { + delete $table->{element}; + + for (@{$table->{column_group}}, @{$table->{column}}, $table->{caption}, + @{$table->{row}}) { next unless $_; delete $_->{element}; } @@ -1002,6 +1017,51 @@ print STDOUT qq[
]; } # print_listing_section +sub print_uri_section ($$$) { + my ($input, $uris) = @_; + + ## NOTE: URIs contained in the DOM (i.e. in HTML or XML documents), + ## except for those in RDF triples. + ## TODO: URIs in CSS + + push @nav, ['#' . $input->{id_prefix} . 'uris' => 'URIs'] + unless $input->{nested}; + print STDOUT qq[ +
+

URIs

+ +
]; + for my $uri (sort {$a cmp $b} keys %$uris) { + my $euri = htescape ($uri); + print STDOUT qq[
<$euri>]; + my $eccuri = htescape (get_cc_uri ($uri)); + print STDOUT qq[
Check conformance of this document]; + print STDOUT qq[
Found at:
    ]; + for my $entry (@{$uris->{$uri}}) { + print STDOUT qq[
  • ], get_node_link ($input, $entry->{node}); + if (keys %{$entry->{type} or {}}) { + print STDOUT ' ('; + print STDOUT join ', ', map { + { + hyperlink => 'Hyperlink', + resource => 'Link to an external resource', + namespace => 'Namespace URI', + cite => 'Citation or link to a long description', + embedded => 'Link to an embedded content', + base => 'Base URI', + action => 'Submission URI', + }->{$_} + or + htescape ($_) + } keys %{$entry->{type}}; + print STDOUT ')'; + } + } + print STDOUT qq[
]; + } + print STDOUT qq[
]; +} # print_uri_section + sub print_rdf_section ($$$) { my ($input, $rdfs) = @_; @@ -1282,10 +1342,10 @@ while (defined $node) { my $rs; if ($node->node_type == 1) { - $rs = $node->manakai_local_name; + $rs = $node->node_name; $node = $node->parent_node; } elsif ($node->node_type == 2) { - $rs = '@' . $node->manakai_local_name; + $rs = '@' . $node->node_name; $node = $node->owner_element; } elsif ($node->node_type == 3) { $rs = '"' . $node->data . '"'; @@ -1363,6 +1423,17 @@ } +sub encode_uri_component ($) { + require Encode; + my $s = Encode::encode ('utf8', shift); + $s =~ s/([^0-9A-Za-z_.~-])/sprintf '%%%02X', ord $1/ge; + return $s; +} # encode_uri_component + +sub get_cc_uri ($) { + return './?uri=' . encode_uri_component ($_[0]); +} # get_cc_uri + sub get_input_document ($$) { my ($http, $dom) = @_; @@ -1552,4 +1623,4 @@ =cut -## $Date: 2008/03/21 09:17:45 $ +## $Date: 2008/05/06 08:47:09 $