86 |
<dd>$char_length byte@{[$char_length == 1 ? '' : 's']}</dd> |
<dd>$char_length byte@{[$char_length == 1 ? '' : 's']}</dd> |
87 |
</dl> |
</dl> |
88 |
</div> |
</div> |
89 |
|
|
90 |
|
<script src="../cc-script.js"></script> |
91 |
]; |
]; |
92 |
|
|
93 |
$input->{id_prefix} = ''; |
$input->{id_prefix} = ''; |
134 |
} elsif ($err->{level} eq 'u' or $err->{level} eq 'unsupported') { |
} elsif ($err->{level} eq 'u' or $err->{level} eq 'unsupported') { |
135 |
$result->{$layer}->{unsupported}++; |
$result->{$layer}->{unsupported}++; |
136 |
$result->{unsupported} = 1; |
$result->{unsupported} = 1; |
137 |
|
} elsif ($err->{level} eq 'i') { |
138 |
|
# |
139 |
} else { |
} else { |
140 |
$result->{$layer}->{must}++; |
$result->{$layer}->{must}++; |
141 |
$result->{$layer}->{score_max} -= 2; |
$result->{$layer}->{score_max} -= 2; |
161 |
my $el; |
my $el; |
162 |
my $cssom; |
my $cssom; |
163 |
my $manifest; |
my $manifest; |
164 |
|
my $idl; |
165 |
my @subdoc; |
my @subdoc; |
166 |
|
|
167 |
if ($input->{media_type} eq 'text/html') { |
if ($input->{media_type} eq 'text/html') { |
174 |
'text/xml' => 1, |
'text/xml' => 1, |
175 |
'application/atom+xml' => 1, |
'application/atom+xml' => 1, |
176 |
'application/rss+xml' => 1, |
'application/rss+xml' => 1, |
177 |
'application/svg+xml' => 1, |
'image/svg+xml' => 1, |
178 |
'application/xhtml+xml' => 1, |
'application/xhtml+xml' => 1, |
179 |
'application/xml' => 1, |
'application/xml' => 1, |
180 |
|
## TODO: Should we make all XML MIME Types fall |
181 |
|
## into this category? |
182 |
|
|
183 |
|
'application/rdf+xml' => 1, ## NOTE: This type has different model. |
184 |
}->{$input->{media_type}}) { |
}->{$input->{media_type}}) { |
185 |
($doc, $el) = print_syntax_error_xml_section ($input, $result); |
($doc, $el) = print_syntax_error_xml_section ($input, $result); |
186 |
print_source_string_section ($input, |
print_source_string_section ($input, |
196 |
$manifest = print_syntax_error_manifest_section ($input, $result); |
$manifest = print_syntax_error_manifest_section ($input, $result); |
197 |
print_source_string_section ($input, \($input->{s}), |
print_source_string_section ($input, \($input->{s}), |
198 |
'utf-8'); |
'utf-8'); |
199 |
|
} elsif ($input->{media_type} eq 'text/x-webidl') { ## TODO: type |
200 |
|
$idl = print_syntax_error_webidl_section ($input, $result); |
201 |
|
print_source_string_section ($input, \($input->{s}), |
202 |
|
'utf-8'); ## TODO: charset |
203 |
} else { |
} else { |
204 |
## TODO: Change HTTP status code?? |
## TODO: Change HTTP status code?? |
205 |
print_result_unknown_type_section ($input, $result); |
print_result_unknown_type_section ($input, $result); |
223 |
print_listing_section ({ |
print_listing_section ({ |
224 |
id => 'classes', label => 'Classes', heading => 'Classes', |
id => 'classes', label => 'Classes', heading => 'Classes', |
225 |
}, $input, $elements->{class}) if keys %{$elements->{class}}; |
}, $input, $elements->{class}) if keys %{$elements->{class}}; |
226 |
|
print_uri_section ($input, $elements->{uri}) if keys %{$elements->{uri}}; |
227 |
|
print_rdf_section ($input, $elements->{rdf}) if @{$elements->{rdf}}; |
228 |
} elsif (defined $cssom) { |
} elsif (defined $cssom) { |
229 |
print_structure_dump_cssom_section ($input, $cssom); |
print_structure_dump_cssom_section ($input, $cssom); |
230 |
## TODO: CSSOM validation |
## TODO: CSSOM validation |
232 |
} elsif (defined $manifest) { |
} elsif (defined $manifest) { |
233 |
print_structure_dump_manifest_section ($input, $manifest); |
print_structure_dump_manifest_section ($input, $manifest); |
234 |
print_structure_error_manifest_section ($input, $manifest, $result); |
print_structure_error_manifest_section ($input, $manifest, $result); |
235 |
|
} elsif (defined $idl) { |
236 |
|
print_structure_dump_webidl_section ($input, $idl); |
237 |
|
print_structure_error_webidl_section ($input, $idl, $result); |
238 |
} |
} |
239 |
|
|
240 |
my $id_prefix = 0; |
my $id_prefix = 0; |
308 |
<div id="$input->{id_prefix}parse-errors" class="section"> |
<div id="$input->{id_prefix}parse-errors" class="section"> |
309 |
<h2>Parse Errors</h2> |
<h2>Parse Errors</h2> |
310 |
|
|
311 |
<dl>]; |
<dl id="$input->{id_prefix}parse-errors-list">]; |
312 |
push @nav, ['#parse-errors' => 'Parse Error'] unless $input->{nested}; |
push @nav, ['#parse-errors' => 'Parse Error'] unless $input->{nested}; |
313 |
|
|
314 |
my $onerror = sub { |
my $onerror = sub { |
315 |
my (%opt) = @_; |
my (%opt) = @_; |
316 |
my ($type, $cls, $msg) = get_text ($opt{type}, $opt{level}); |
my ($type, $cls, $msg) = get_text ($opt{type}, $opt{level}); |
317 |
if ($opt{column} > 0) { |
print STDOUT qq[<dt class="$cls">], get_error_label ($input, \%opt), |
318 |
print STDOUT qq[<dt class="$cls"><a href="#$input->{id_prefix}line-$opt{line}">Line $opt{line}</a> column $opt{column}</dt>\n]; |
qq[</dt>]; |
|
} else { |
|
|
$opt{line} = $opt{line} - 1 || 1; |
|
|
print STDOUT qq[<dt class="$cls"><a href="#$input->{id_prefix}line-$opt{line}">Line $opt{line}</a></dt>\n]; |
|
|
} |
|
319 |
$type =~ tr/ /-/; |
$type =~ tr/ /-/; |
320 |
$type =~ s/\|/%7C/g; |
$type =~ s/\|/%7C/g; |
321 |
$msg .= qq[ [<a href="../error-description#@{[htescape ($type)]}">Description</a>]]; |
$msg .= qq[ [<a href="../error-description#@{[htescape ($type)]}">Description</a>]]; |
331 |
if (defined $inner_html_element and length $inner_html_element) { |
if (defined $inner_html_element and length $inner_html_element) { |
332 |
$input->{charset} ||= 'windows-1252'; ## TODO: for now. |
$input->{charset} ||= 'windows-1252'; ## TODO: for now. |
333 |
my $time1 = time; |
my $time1 = time; |
334 |
my $t = Encode::decode ($input->{charset}, $input->{s}); |
my $t = \($input->{s}); |
335 |
|
unless ($input->{is_char_string}) { |
336 |
|
$t = \(Encode::decode ($input->{charset}, $$t)); |
337 |
|
} |
338 |
$time{decode} = time - $time1; |
$time{decode} = time - $time1; |
339 |
|
|
340 |
$el = $doc->create_element_ns |
$el = $doc->create_element_ns |
341 |
('http://www.w3.org/1999/xhtml', [undef, $inner_html_element]); |
('http://www.w3.org/1999/xhtml', [undef, $inner_html_element]); |
342 |
$time1 = time; |
$time1 = time; |
343 |
Whatpm::HTML->set_inner_html ($el, $t, $onerror); |
Whatpm::HTML->set_inner_html ($el, $$t, $onerror); |
344 |
$time{parse} = time - $time1; |
$time{parse} = time - $time1; |
345 |
} else { |
} else { |
346 |
my $time1 = time; |
my $time1 = time; |
347 |
Whatpm::HTML->parse_byte_string |
if ($input->{is_char_string}) { |
348 |
($input->{charset}, $input->{s} => $doc, $onerror); |
Whatpm::HTML->parse_char_string ($input->{s} => $doc, $onerror); |
349 |
|
} else { |
350 |
|
Whatpm::HTML->parse_byte_string |
351 |
|
($input->{charset}, $input->{s} => $doc, $onerror); |
352 |
|
} |
353 |
$time{parse_html} = time - $time1; |
$time{parse_html} = time - $time1; |
354 |
} |
} |
355 |
$doc->manakai_charset ($input->{official_charset}) |
$doc->manakai_charset ($input->{official_charset}) |
369 |
<div id="$input->{id_prefix}parse-errors" class="section"> |
<div id="$input->{id_prefix}parse-errors" class="section"> |
370 |
<h2>Parse Errors</h2> |
<h2>Parse Errors</h2> |
371 |
|
|
372 |
<dl>]; |
<dl id="$input->{id_prefix}parse-errors-list">]; |
373 |
push @nav, ['#parse-errors' => 'Parse Error'] unless $input->{prefix}; |
push @nav, ['#parse-errors' => 'Parse Error'] unless $input->{prefix}; |
374 |
|
|
375 |
my $onerror = sub { |
my $onerror = sub { |
389 |
return 1; |
return 1; |
390 |
}; |
}; |
391 |
|
|
392 |
|
my $t = \($input->{s}); |
393 |
|
if ($input->{is_char_string}) { |
394 |
|
require Encode; |
395 |
|
$t = \(Encode::encode ('utf8', $$t)); |
396 |
|
$input->{charset} = 'utf-8'; |
397 |
|
} |
398 |
|
|
399 |
my $time1 = time; |
my $time1 = time; |
400 |
open my $fh, '<', \($input->{s}); |
open my $fh, '<', $t; |
401 |
my $doc = Message::DOM::XMLParserTemp->parse_byte_stream |
my $doc = Message::DOM::XMLParserTemp->parse_byte_stream |
402 |
($fh => $dom, $onerror, charset => $input->{charset}); |
($fh => $dom, $onerror, charset => $input->{charset}); |
403 |
$time{parse_xml} = time - $time1; |
$time{parse_xml} = time - $time1; |
416 |
require Whatpm::CSS::Parser; |
require Whatpm::CSS::Parser; |
417 |
my $p = Whatpm::CSS::Parser->new; |
my $p = Whatpm::CSS::Parser->new; |
418 |
|
|
|
# if ($parse_mode eq 'q') { |
|
|
# $p->{unitless_px} = 1; |
|
|
# $p->{hashless_color} = 1; |
|
|
# } |
|
|
|
|
419 |
$p->{prop}->{$_} = 1 for qw/ |
$p->{prop}->{$_} = 1 for qw/ |
420 |
|
alignment-baseline |
421 |
background background-attachment background-color background-image |
background background-attachment background-color background-image |
422 |
background-position background-position-x background-position-y |
background-position background-position-x background-position-y |
423 |
background-repeat border border-bottom border-bottom-color |
background-repeat border border-bottom border-bottom-color |
429 |
border-style border-top border-top-color border-top-style border-top-width |
border-style border-top border-top-color border-top-style border-top-width |
430 |
border-width bottom |
border-width bottom |
431 |
caption-side clear clip color content counter-increment counter-reset |
caption-side clear clip color content counter-increment counter-reset |
432 |
cursor direction display empty-cells float font |
cursor direction display dominant-baseline empty-cells float font |
433 |
font-family font-size font-size-adjust font-stretch |
font-family font-size font-size-adjust font-stretch |
434 |
font-style font-variant font-weight height left |
font-style font-variant font-weight height left |
435 |
letter-spacing line-height |
letter-spacing line-height |
441 |
padding padding-bottom padding-left padding-right padding-top |
padding padding-bottom padding-left padding-right padding-top |
442 |
page page-break-after page-break-before page-break-inside |
page page-break-after page-break-before page-break-inside |
443 |
position quotes right size table-layout |
position quotes right size table-layout |
444 |
text-align text-decoration text-indent text-transform |
text-align text-anchor text-decoration text-indent text-transform |
445 |
top unicode-bidi vertical-align visibility white-space width widows |
top unicode-bidi vertical-align visibility white-space width widows |
446 |
word-spacing z-index |
word-spacing writing-mode z-index |
447 |
/; |
/; |
448 |
$p->{prop_value}->{display}->{$_} = 1 for qw/ |
$p->{prop_value}->{display}->{$_} = 1 for qw/ |
449 |
block clip inline inline-block inline-table list-item none |
block clip inline inline-block inline-table list-item none |
520 |
$p->{prop_value}->{'white-space'}->{$_} = 1 for qw/ |
$p->{prop_value}->{'white-space'}->{$_} = 1 for qw/ |
521 |
normal pre nowrap pre-line pre-wrap -moz-pre-wrap |
normal pre nowrap pre-line pre-wrap -moz-pre-wrap |
522 |
/; |
/; |
523 |
|
$p->{prop_value}->{'writing-mode'}->{$_} = 1 for qw/ |
524 |
|
lr rl tb lr-tb rl-tb tb-rl |
525 |
|
/; |
526 |
|
$p->{prop_value}->{'text-anchor'}->{$_} = 1 for qw/ |
527 |
|
start middle end |
528 |
|
/; |
529 |
|
$p->{prop_value}->{'dominant-baseline'}->{$_} = 1 for qw/ |
530 |
|
auto use-script no-change reset-size ideographic alphabetic |
531 |
|
hanging mathematical central middle text-after-edge text-before-edge |
532 |
|
/; |
533 |
|
$p->{prop_value}->{'alignment-baseline'}->{$_} = 1 for qw/ |
534 |
|
auto baseline before-edge text-before-edge middle central |
535 |
|
after-edge text-after-edge ideographic alphabetic hanging |
536 |
|
mathematical |
537 |
|
/; |
538 |
$p->{prop_value}->{'text-decoration'}->{$_} = 1 for qw/ |
$p->{prop_value}->{'text-decoration'}->{$_} = 1 for qw/ |
539 |
none blink underline overline line-through |
none blink underline overline line-through |
540 |
/; |
/; |
587 |
<div id="$input->{id_prefix}parse-errors" class="section"> |
<div id="$input->{id_prefix}parse-errors" class="section"> |
588 |
<h2>Parse Errors</h2> |
<h2>Parse Errors</h2> |
589 |
|
|
590 |
<dl>]; |
<dl id="$input->{id_prefix}parse-errors-list">]; |
591 |
push @nav, ['#parse-errors' => 'Parse Error'] unless $input->{nested}; |
push @nav, ['#parse-errors' => 'Parse Error'] unless $input->{nested}; |
592 |
|
|
593 |
my $p = get_css_parser (); |
my $p = get_css_parser (); |
594 |
|
$p->init; |
595 |
$p->{onerror} = sub { |
$p->{onerror} = sub { |
596 |
my (%opt) = @_; |
my (%opt) = @_; |
597 |
my ($type, $cls, $msg) = get_text ($opt{type}, $opt{level}); |
my ($type, $cls, $msg) = get_text ($opt{type}, $opt{level}); |
616 |
$p->{href} = $input->{uri}; |
$p->{href} = $input->{uri}; |
617 |
$p->{base_uri} = $input->{base_uri}; |
$p->{base_uri} = $input->{base_uri}; |
618 |
|
|
619 |
|
# if ($parse_mode eq 'q') { |
620 |
|
# $p->{unitless_px} = 1; |
621 |
|
# $p->{hashless_color} = 1; |
622 |
|
# } |
623 |
|
|
624 |
|
## TODO: Make $input->{s} a ref. |
625 |
|
|
626 |
my $s = \$input->{s}; |
my $s = \$input->{s}; |
627 |
my $charset; |
my $charset; |
628 |
unless ($input->{is_char_string}) { |
unless ($input->{is_char_string}) { |
653 |
<div id="$input->{id_prefix}parse-errors" class="section"> |
<div id="$input->{id_prefix}parse-errors" class="section"> |
654 |
<h2>Parse Errors</h2> |
<h2>Parse Errors</h2> |
655 |
|
|
656 |
<dl>]; |
<dl id="$input->{id_prefix}parse-errors-list">]; |
657 |
push @nav, ['#parse-errors' => 'Parse Error'] unless $input->{nested}; |
push @nav, ['#parse-errors' => 'Parse Error'] unless $input->{nested}; |
658 |
|
|
659 |
my $onerror = sub { |
my $onerror = sub { |
670 |
add_error ('syntax', \%opt => $result); |
add_error ('syntax', \%opt => $result); |
671 |
}; |
}; |
672 |
|
|
673 |
|
my $m = $input->{is_char_string} ? 'parse_char_string' : 'parse_byte_string'; |
674 |
my $time1 = time; |
my $time1 = time; |
675 |
my $manifest = Whatpm::CacheManifest->parse_byte_string |
my $manifest = Whatpm::CacheManifest->$m |
676 |
($input->{s}, $input->{uri}, $input->{base_uri}, $onerror); |
($input->{s}, $input->{uri}, $input->{base_uri}, $onerror); |
677 |
$time{parse_manifest} = time - $time1; |
$time{parse_manifest} = time - $time1; |
678 |
|
|
681 |
return $manifest; |
return $manifest; |
682 |
} # print_syntax_error_manifest_section |
} # print_syntax_error_manifest_section |
683 |
|
|
684 |
|
sub print_syntax_error_webidl_section ($$) { |
685 |
|
my ($input, $result) = @_; |
686 |
|
|
687 |
|
require Whatpm::WebIDL; |
688 |
|
|
689 |
|
print STDOUT qq[ |
690 |
|
<div id="$input->{id_prefix}parse-errors" class="section"> |
691 |
|
<h2>Parse Errors</h2> |
692 |
|
|
693 |
|
<dl id="$input->{id_prefix}parse-errors-list">]; |
694 |
|
push @nav, ['#parse-errors' => 'Parse Error'] unless $input->{nested}; |
695 |
|
|
696 |
|
my $onerror = sub { |
697 |
|
my (%opt) = @_; |
698 |
|
my ($type, $cls, $msg) = get_text ($opt{type}, $opt{level}); |
699 |
|
print STDOUT qq[<dt class="$cls">], get_error_label ($input, \%opt), |
700 |
|
qq[</dt>]; |
701 |
|
$type =~ tr/ /-/; |
702 |
|
$type =~ s/\|/%7C/g; |
703 |
|
$msg .= qq[ [<a href="../error-description#@{[htescape ($type)]}">Description</a>]]; |
704 |
|
print STDOUT qq[<dd class="$cls">], get_error_level_label (\%opt); |
705 |
|
print STDOUT qq[$msg</dd>\n]; |
706 |
|
|
707 |
|
add_error ('syntax', \%opt => $result); |
708 |
|
}; |
709 |
|
|
710 |
|
require Encode; |
711 |
|
my $s = $input->{is_char_string} ? $input->{s} : Encode::decode ($input->{charset} || 'utf-8', $input->{s}); ## TODO: charset |
712 |
|
my $parser = Whatpm::WebIDL::Parser->new; |
713 |
|
my $idl = $parser->parse_char_string ($input->{s}, $onerror); |
714 |
|
|
715 |
|
print STDOUT qq[</dl></div>]; |
716 |
|
|
717 |
|
return $idl; |
718 |
|
} # print_syntax_error_webidl_section |
719 |
|
|
720 |
sub print_source_string_section ($$$) { |
sub print_source_string_section ($$$) { |
721 |
my $input = shift; |
my $input = shift; |
722 |
my $s; |
my $s; |
723 |
unless ($input->{is_char_string}) { |
unless ($input->{is_char_string}) { |
724 |
require Encode; |
open my $byte_stream, '<', $_[0]; |
725 |
my $enc = Encode::find_encoding ($_[1]); ## TODO: charset name -> Perl name |
require Message::Charset::Info; |
726 |
return unless $enc; |
my $charset = Message::Charset::Info->get_by_iana_name ($_[1]); |
727 |
|
my ($char_stream, $e_status) = $charset->get_decode_handle |
728 |
|
($byte_stream, allow_error_reporting => 1, allow_fallback => 1); |
729 |
|
return unless $char_stream; |
730 |
|
|
731 |
|
$char_stream->onerror (sub { |
732 |
|
my (undef, $type, %opt) = @_; |
733 |
|
if ($opt{octets}) { |
734 |
|
${$opt{octets}} = "\x{FFFD}"; |
735 |
|
} |
736 |
|
}); |
737 |
|
|
738 |
$s = \($enc->decode (${$_[0]})); |
my $t = ''; |
739 |
|
while (1) { |
740 |
|
my $c = $char_stream->getc; |
741 |
|
last unless defined $c; |
742 |
|
$t .= $c; |
743 |
|
} |
744 |
|
$s = \$t; |
745 |
|
## TODO: Output for each line, don't concat all of lines. |
746 |
} else { |
} else { |
747 |
$s = $_[0]; |
$s = $_[0]; |
748 |
} |
} |
753 |
<h2>Document Source</h2> |
<h2>Document Source</h2> |
754 |
<ol lang="">\n]; |
<ol lang="">\n]; |
755 |
if (length $$s) { |
if (length $$s) { |
756 |
while ($$s =~ /\G([^\x0A]*?)\x0D?\x0A/gc) { |
while ($$s =~ /\G([^\x0D\x0A]*?)(?>\x0D\x0A?|\x0A)/gc) { |
757 |
print STDOUT qq[<li id="$input->{id_prefix}line-$i">], htescape $1, |
print STDOUT qq[<li id="$input->{id_prefix}line-$i">], htescape $1, |
758 |
"</li>\n"; |
"</li>\n"; |
759 |
$i++; |
$i++; |
760 |
} |
} |
761 |
if ($$s =~ /\G([^\x0A]+)/gc) { |
if ($$s =~ /\G([^\x0D\x0A]+)/gc) { |
762 |
print STDOUT qq[<li id="$input->{id_prefix}line-$i">], htescape $1, |
print STDOUT qq[<li id="$input->{id_prefix}line-$i">], htescape $1, |
763 |
"</li>\n"; |
"</li>\n"; |
764 |
} |
} |
765 |
} else { |
} else { |
766 |
print STDOUT q[<li id="$input->{id_prefix}line-1"></li>]; |
print STDOUT q[<li id="$input->{id_prefix}line-1"></li>]; |
767 |
} |
} |
768 |
print STDOUT "</ol></div>"; |
print STDOUT "</ol></div> |
769 |
|
<script> |
770 |
|
addSourceToParseErrorList ('$input->{id_prefix}', 'parse-errors-list'); |
771 |
|
</script>"; |
772 |
} # print_input_string_section |
} # print_input_string_section |
773 |
|
|
774 |
sub print_document_tree ($$) { |
sub print_document_tree ($$) { |
906 |
unless $input->{nested}; |
unless $input->{nested}; |
907 |
|
|
908 |
print STDOUT qq[<dl><dt>Explicit entries</dt>]; |
print STDOUT qq[<dl><dt>Explicit entries</dt>]; |
909 |
|
my $i = 0; |
910 |
for my $uri (@{$manifest->[0]}) { |
for my $uri (@{$manifest->[0]}) { |
911 |
my $euri = htescape ($uri); |
my $euri = htescape ($uri); |
912 |
print STDOUT qq[<dd><code class=uri><<a href="$euri">$euri</a>></code></dd>]; |
print STDOUT qq[<dd id="$input->{id_prefix}index-@{[$i++]}"><code class=uri><<a href="$euri">$euri</a>></code></dd>]; |
913 |
} |
} |
914 |
|
|
915 |
print STDOUT qq[<dt>Fallback entries</dt><dd> |
print STDOUT qq[<dt>Fallback entries</dt><dd> |
918 |
for my $uri (sort {$a cmp $b} keys %{$manifest->[1]}) { |
for my $uri (sort {$a cmp $b} keys %{$manifest->[1]}) { |
919 |
my $euri = htescape ($uri); |
my $euri = htescape ($uri); |
920 |
my $euri2 = htescape ($manifest->[1]->{$uri}); |
my $euri2 = htescape ($manifest->[1]->{$uri}); |
921 |
print STDOUT qq[<tr><td><code class=uri><<a href="$euri">$euri</a>></code></td> |
print STDOUT qq[<tr><td id="$input->{id_prefix}index-@{[$i++]}"><code class=uri><<a href="$euri">$euri</a>></code></td> |
922 |
<td><code class=uri><<a href="$euri2">$euri2</a>></code></td>]; |
<td id="$input->{id_prefix}index-@{[$i++]}"><code class=uri><<a href="$euri2">$euri2</a>></code></td>]; |
923 |
} |
} |
924 |
|
|
925 |
print STDOUT qq[</table><dt>Online whitelist</dt>]; |
print STDOUT qq[</table><dt>Online whitelist</dt>]; |
926 |
for my $uri (@{$manifest->[2]}) { |
for my $uri (@{$manifest->[2]}) { |
927 |
my $euri = htescape ($uri); |
my $euri = htescape ($uri); |
928 |
print STDOUT qq[<dd><code class=uri><<a href="$euri">$euri</a>></code></dd>]; |
print STDOUT qq[<dd id="$input->{id_prefix}index-@{[$i++]}"><code class=uri><<a href="$euri">$euri</a>></code></dd>]; |
929 |
} |
} |
930 |
|
|
931 |
print STDOUT qq[</dl></div>]; |
print STDOUT qq[</dl></div>]; |
932 |
} # print_structure_dump_manifest_section |
} # print_structure_dump_manifest_section |
933 |
|
|
934 |
|
sub print_structure_dump_webidl_section ($$) { |
935 |
|
my ($input, $idl) = @_; |
936 |
|
|
937 |
|
print STDOUT qq[ |
938 |
|
<div id="$input->{id_prefix}dump-webidl" class="section"> |
939 |
|
<h2>WebIDL</h2> |
940 |
|
]; |
941 |
|
push @nav, [qq[#$input->{id_prefix}dump-webidl] => 'WebIDL'] |
942 |
|
unless $input->{nested}; |
943 |
|
|
944 |
|
print STDOUT "<pre>"; |
945 |
|
print STDOUT htescape ($idl->idl_text); |
946 |
|
print STDOUT "</pre>"; |
947 |
|
|
948 |
|
print STDOUT qq[</div>]; |
949 |
|
} # print_structure_dump_webidl_section |
950 |
|
|
951 |
sub print_structure_error_dom_section ($$$$$) { |
sub print_structure_error_dom_section ($$$$$) { |
952 |
my ($input, $doc, $el, $result, $onsubdoc) = @_; |
my ($input, $doc, $el, $result, $onsubdoc) = @_; |
953 |
|
|
954 |
print STDOUT qq[<div id="$input->{id_prefix}document-errors" class="section"> |
print STDOUT qq[<div id="$input->{id_prefix}document-errors" class="section"> |
955 |
<h2>Document Errors</h2> |
<h2>Document Errors</h2> |
956 |
|
|
957 |
<dl>]; |
<dl id=document-errors-list>]; |
958 |
push @nav, [qq[#$input->{id_prefix}document-errors] => 'Document Error'] |
push @nav, [qq[#$input->{id_prefix}document-errors] => 'Document Error'] |
959 |
unless $input->{nested}; |
unless $input->{nested}; |
960 |
|
|
982 |
} |
} |
983 |
$time{check} = time - $time1; |
$time{check} = time - $time1; |
984 |
|
|
985 |
print STDOUT qq[</dl></div>]; |
print STDOUT qq[</dl> |
986 |
|
<script> |
987 |
|
addSourceToParseErrorList ('$input->{id_prefix}', 'document-errors-list'); |
988 |
|
</script></div>]; |
989 |
|
|
990 |
return $elements; |
return $elements; |
991 |
} # print_structure_error_dom_section |
} # print_structure_error_dom_section |
1015 |
print STDOUT qq[</div>]; |
print STDOUT qq[</div>]; |
1016 |
} # print_structure_error_manifest_section |
} # print_structure_error_manifest_section |
1017 |
|
|
1018 |
|
sub print_structure_error_webidl_section ($$$) { |
1019 |
|
my ($input, $idl, $result) = @_; |
1020 |
|
|
1021 |
|
print STDOUT qq[<div id="$input->{id_prefix}document-errors" class="section"> |
1022 |
|
<h2>Document Errors</h2> |
1023 |
|
|
1024 |
|
<dl>]; |
1025 |
|
push @nav, [qq[#$input->{id_prefix}document-errors] => 'Document Error'] |
1026 |
|
unless $input->{nested}; |
1027 |
|
|
1028 |
|
## TODO: |
1029 |
|
|
1030 |
|
print STDOUT qq[</div>]; |
1031 |
|
} # print_structure_error_webidl_section |
1032 |
|
|
1033 |
sub print_table_section ($$) { |
sub print_table_section ($$) { |
1034 |
my ($input, $tables) = @_; |
my ($input, $tables) = @_; |
1035 |
|
|
1049 |
require JSON; |
require JSON; |
1050 |
|
|
1051 |
my $i = 0; |
my $i = 0; |
1052 |
for my $table_el (@$tables) { |
for my $table (@$tables) { |
1053 |
$i++; |
$i++; |
1054 |
print STDOUT qq[<div class="section" id="$input->{id_prefix}table-$i"><h3>] . |
print STDOUT qq[<div class="section" id="$input->{id_prefix}table-$i"><h3>] . |
1055 |
get_node_link ($input, $table_el) . q[</h3>]; |
get_node_link ($input, $table->{element}) . q[</h3>]; |
1056 |
|
|
1057 |
## TODO: Make |ContentChecker| return |form_table| result |
delete $table->{element}; |
1058 |
## so that this script don't have to run the algorithm twice. |
|
1059 |
my $table = Whatpm::HTMLTable->form_table ($table_el); |
for (@{$table->{column_group}}, @{$table->{column}}, $table->{caption}, |
1060 |
|
@{$table->{row}}) { |
|
for (@{$table->{column_group}}, @{$table->{column}}, $table->{caption}) { |
|
1061 |
next unless $_; |
next unless $_; |
1062 |
delete $_->{element}; |
delete $_->{element}; |
1063 |
} |
} |
1110 |
print STDOUT qq[</dl></div>]; |
print STDOUT qq[</dl></div>]; |
1111 |
} # print_listing_section |
} # print_listing_section |
1112 |
|
|
1113 |
|
sub print_uri_section ($$$) { |
1114 |
|
my ($input, $uris) = @_; |
1115 |
|
|
1116 |
|
## NOTE: URIs contained in the DOM (i.e. in HTML or XML documents), |
1117 |
|
## except for those in RDF triples. |
1118 |
|
## TODO: URIs in CSS |
1119 |
|
|
1120 |
|
push @nav, ['#' . $input->{id_prefix} . 'uris' => 'URIs'] |
1121 |
|
unless $input->{nested}; |
1122 |
|
print STDOUT qq[ |
1123 |
|
<div id="$input->{id_prefix}uris" class="section"> |
1124 |
|
<h2>URIs</h2> |
1125 |
|
|
1126 |
|
<dl>]; |
1127 |
|
for my $uri (sort {$a cmp $b} keys %$uris) { |
1128 |
|
my $euri = htescape ($uri); |
1129 |
|
print STDOUT qq[<dt><code class=uri><<a href="$euri">$euri</a>></code>]; |
1130 |
|
my $eccuri = htescape (get_cc_uri ($uri)); |
1131 |
|
print STDOUT qq[<dd><a href="$eccuri">Check conformance of this document</a>]; |
1132 |
|
print STDOUT qq[<dd>Found at: <ul>]; |
1133 |
|
for my $entry (@{$uris->{$uri}}) { |
1134 |
|
print STDOUT qq[<li>], get_node_link ($input, $entry->{node}); |
1135 |
|
if (keys %{$entry->{type} or {}}) { |
1136 |
|
print STDOUT ' ('; |
1137 |
|
print STDOUT join ', ', map { |
1138 |
|
{ |
1139 |
|
hyperlink => 'Hyperlink', |
1140 |
|
resource => 'Link to an external resource', |
1141 |
|
namespace => 'Namespace URI', |
1142 |
|
cite => 'Citation or link to a long description', |
1143 |
|
embedded => 'Link to an embedded content', |
1144 |
|
base => 'Base URI', |
1145 |
|
action => 'Submission URI', |
1146 |
|
}->{$_} |
1147 |
|
or |
1148 |
|
htescape ($_) |
1149 |
|
} keys %{$entry->{type}}; |
1150 |
|
print STDOUT ')'; |
1151 |
|
} |
1152 |
|
} |
1153 |
|
print STDOUT qq[</ul>]; |
1154 |
|
} |
1155 |
|
print STDOUT qq[</dl></div>]; |
1156 |
|
} # print_uri_section |
1157 |
|
|
1158 |
|
sub print_rdf_section ($$$) { |
1159 |
|
my ($input, $rdfs) = @_; |
1160 |
|
|
1161 |
|
push @nav, ['#' . $input->{id_prefix} . 'rdf' => 'RDF'] |
1162 |
|
unless $input->{nested}; |
1163 |
|
print STDOUT qq[ |
1164 |
|
<div id="$input->{id_prefix}rdf" class="section"> |
1165 |
|
<h2>RDF Triples</h2> |
1166 |
|
|
1167 |
|
<dl>]; |
1168 |
|
my $i = 0; |
1169 |
|
for my $rdf (@$rdfs) { |
1170 |
|
print STDOUT qq[<dt id="$input->{id_prefix}rdf-@{[$i++]}">]; |
1171 |
|
print STDOUT get_node_link ($input, $rdf->[0]); |
1172 |
|
print STDOUT qq[<dd><dl>]; |
1173 |
|
for my $triple (@{$rdf->[1]}) { |
1174 |
|
print STDOUT '<dt>' . get_node_link ($input, $triple->[0]) . '<dd>'; |
1175 |
|
print STDOUT get_rdf_resource_html ($triple->[1]); |
1176 |
|
print STDOUT ' '; |
1177 |
|
print STDOUT get_rdf_resource_html ($triple->[2]); |
1178 |
|
print STDOUT ' '; |
1179 |
|
print STDOUT get_rdf_resource_html ($triple->[3]); |
1180 |
|
} |
1181 |
|
print STDOUT qq[</dl>]; |
1182 |
|
} |
1183 |
|
print STDOUT qq[</dl></div>]; |
1184 |
|
} # print_rdf_section |
1185 |
|
|
1186 |
|
sub get_rdf_resource_html ($) { |
1187 |
|
my $resource = shift; |
1188 |
|
if (defined $resource->{uri}) { |
1189 |
|
my $euri = htescape ($resource->{uri}); |
1190 |
|
return '<code class=uri><<a href="' . $euri . '">' . $euri . |
1191 |
|
'</a>></code>'; |
1192 |
|
} elsif (defined $resource->{bnodeid}) { |
1193 |
|
return htescape ('_:' . $resource->{bnodeid}); |
1194 |
|
} elsif ($resource->{nodes}) { |
1195 |
|
return '(rdf:XMLLiteral)'; |
1196 |
|
} elsif (defined $resource->{value}) { |
1197 |
|
my $elang = htescape (defined $resource->{language} |
1198 |
|
? $resource->{language} : ''); |
1199 |
|
my $r = qq[<q lang="$elang">] . htescape ($resource->{value}) . '</q>'; |
1200 |
|
if (defined $resource->{datatype}) { |
1201 |
|
my $euri = htescape ($resource->{datatype}); |
1202 |
|
$r .= '^^<code class=uri><<a href="' . $euri . '">' . $euri . |
1203 |
|
'</a>></code>'; |
1204 |
|
} elsif (length $resource->{language}) { |
1205 |
|
$r .= '@' . htescape ($resource->{language}); |
1206 |
|
} |
1207 |
|
return $r; |
1208 |
|
} else { |
1209 |
|
return '??'; |
1210 |
|
} |
1211 |
|
} # get_rdf_resource_html |
1212 |
|
|
1213 |
sub print_result_section ($) { |
sub print_result_section ($) { |
1214 |
my $result = shift; |
my $result = shift; |
1215 |
|
|
1275 |
|
|
1276 |
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>]; |
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>]; |
1277 |
if ($uncertain) { |
if ($uncertain) { |
1278 |
print qq[<td class="@{[$result->{$_->[1]}->{must} ? 'FAIL' : $result->{$_->[1]}->{should} ? 'SEE-RESULT' : '']}">−∞..$result->{$_->[1]}->{score_max}</td>]; |
print qq[<td class="@{[$result->{$_->[1]}->{must} ? 'FAIL' : $result->{$_->[1]}->{should} ? 'SEE-RESULT' : '']}">−∞..$result->{$_->[1]}->{score_max}]; |
1279 |
} elsif ($result->{$_->[1]}->{score_min} != $result->{$_->[1]}->{score_max}) { |
} elsif ($result->{$_->[1]}->{score_min} != $result->{$_->[1]}->{score_max}) { |
1280 |
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}]; |
1281 |
} else { |
} else { |
1282 |
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}]; |
1283 |
} |
} |
1284 |
|
print qq[ / 20]; |
1285 |
} |
} |
1286 |
|
|
1287 |
$score_max += $score_base; |
$score_max += $score_base; |
1288 |
|
|
1289 |
print STDOUT qq[ |
print STDOUT qq[ |
1290 |
<tr class=uncertain><th scope=row>Semantics</th><td>0?</td><td>0?</td><td>0?</td><td>−∞..$score_base</td></tr> |
<tr class=uncertain><th scope=row>Semantics</th><td>0?</td><td>0?</td><td>0?</td><td>−∞..$score_base / 20 |
1291 |
</tbody> |
</tbody> |
1292 |
<tfoot><tr class=uncertain><th scope=row>Total</th> |
<tfoot><tr class=uncertain><th scope=row>Total</th> |
1293 |
<td class="@{[$must_error ? 'FAIL' : '']}">$must_error?</td> |
<td class="@{[$must_error ? 'FAIL' : '']}">$must_error?</td> |
1294 |
<td class="@{[$should_error ? 'SEE-RESULT' : '']}">$should_error?</td> |
<td class="@{[$should_error ? 'SEE-RESULT' : '']}">$should_error?</td> |
1295 |
<td>$warning?</td> |
<td>$warning?</td> |
1296 |
<td class="@{[$must_error ? 'FAIL' : $should_error ? 'SEE-RESULT' : '']}"><strong>−∞..$score_max</strong></td></tr></tfoot> |
<td class="@{[$must_error ? 'FAIL' : $should_error ? 'SEE-RESULT' : '']}"><strong>−∞..$score_max</strong> / 100 |
1297 |
</table> |
</table> |
1298 |
|
|
1299 |
<p><strong>Important</strong>: This conformance checking service |
<p><strong>Important</strong>: This conformance checking service |
1340 |
|
|
1341 |
my $r = ''; |
my $r = ''; |
1342 |
|
|
1343 |
if (defined $err->{line}) { |
my $line; |
1344 |
if ($err->{column} > 0) { |
my $column; |
1345 |
$r = qq[<a href="#$input->{id_prefix}line-$err->{line}">Line $err->{line}</a> column $err->{column}]; |
|
1346 |
|
if (defined $err->{node}) { |
1347 |
|
$line = $err->{node}->get_user_data ('manakai_source_line'); |
1348 |
|
if (defined $line) { |
1349 |
|
$column = $err->{node}->get_user_data ('manakai_source_column'); |
1350 |
|
} else { |
1351 |
|
if ($err->{node}->node_type == $err->{node}->ATTRIBUTE_NODE) { |
1352 |
|
my $owner = $err->{node}->owner_element; |
1353 |
|
$line = $owner->get_user_data ('manakai_source_line'); |
1354 |
|
$column = $owner->get_user_data ('manakai_source_column'); |
1355 |
|
} else { |
1356 |
|
my $parent = $err->{node}->parent_node; |
1357 |
|
if ($parent) { |
1358 |
|
$line = $parent->get_user_data ('manakai_source_line'); |
1359 |
|
$column = $parent->get_user_data ('manakai_source_column'); |
1360 |
|
} |
1361 |
|
} |
1362 |
|
} |
1363 |
|
} |
1364 |
|
unless (defined $line) { |
1365 |
|
if (defined $err->{token} and defined $err->{token}->{line}) { |
1366 |
|
$line = $err->{token}->{line}; |
1367 |
|
$column = $err->{token}->{column}; |
1368 |
|
} elsif (defined $err->{line}) { |
1369 |
|
$line = $err->{line}; |
1370 |
|
$column = $err->{column}; |
1371 |
|
} |
1372 |
|
} |
1373 |
|
|
1374 |
|
if (defined $line) { |
1375 |
|
if (defined $column and $column > 0) { |
1376 |
|
$r = qq[<a href="#$input->{id_prefix}line-$line">Line $line</a> column $column]; |
1377 |
} else { |
} else { |
1378 |
$err->{line} = $err->{line} - 1 || 1; |
$line = $line - 1 || 1; |
1379 |
$r = qq[<a href="#$input->{id_prefix}line-$err->{line}">Line $err->{line}</a>]; |
$r = qq[<a href="#$input->{id_prefix}line-$line">Line $line</a>]; |
1380 |
} |
} |
1381 |
} |
} |
1382 |
|
|
1383 |
if (defined $err->{node}) { |
if (defined $err->{node}) { |
1384 |
$r .= ' ' if length $r; |
$r .= ' ' if length $r; |
1385 |
$r = get_node_link ($input, $err->{node}); |
$r .= get_node_link ($input, $err->{node}); |
1386 |
} |
} |
1387 |
|
|
1388 |
if (defined $err->{index}) { |
if (defined $err->{index}) { |
1389 |
$r .= ' ' if length $r; |
if (length $r) { |
1390 |
$r .= 'Index ' . (0+$err->{index}); |
$r .= ', Index ' . (0+$err->{index}); |
1391 |
|
} else { |
1392 |
|
$r .= "<a href='#$input->{id_prefix}index-@{[0+$err->{index}]}'>Index " |
1393 |
|
. (0+$err->{index}) . '</a>'; |
1394 |
|
} |
1395 |
} |
} |
1396 |
|
|
1397 |
if (defined $err->{value}) { |
if (defined $err->{value}) { |
1419 |
} elsif ($err->{level} eq 'u' or $err->{level} eq 'unsupported') { |
} elsif ($err->{level} eq 'u' or $err->{level} eq 'unsupported') { |
1420 |
$r = qq[<strong><a href="../error-description#level-u">Not |
$r = qq[<strong><a href="../error-description#level-u">Not |
1421 |
supported</a></strong>: ]; |
supported</a></strong>: ]; |
1422 |
|
} elsif ($err->{level} eq 'i') { |
1423 |
|
$r = qq[<strong><a href="../error-description#level-i">Information</a></strong>: ]; |
1424 |
} else { |
} else { |
1425 |
my $elevel = htescape ($err->{level}); |
my $elevel = htescape ($err->{level}); |
1426 |
$r = qq[<strong><a href="../error-description#level-$elevel">$elevel</a></strong>: |
$r = qq[<strong><a href="../error-description#level-$elevel">$elevel</a></strong>: |
1436 |
while (defined $node) { |
while (defined $node) { |
1437 |
my $rs; |
my $rs; |
1438 |
if ($node->node_type == 1) { |
if ($node->node_type == 1) { |
1439 |
$rs = $node->manakai_local_name; |
$rs = $node->node_name; |
1440 |
$node = $node->parent_node; |
$node = $node->parent_node; |
1441 |
} elsif ($node->node_type == 2) { |
} elsif ($node->node_type == 2) { |
1442 |
$rs = '@' . $node->manakai_local_name; |
$rs = '@' . $node->node_name; |
1443 |
$node = $node->owner_element; |
$node = $node->owner_element; |
1444 |
} elsif ($node->node_type == 3) { |
} elsif ($node->node_type == 3) { |
1445 |
$rs = '"' . $node->data . '"'; |
$rs = '"' . $node->data . '"'; |
1517 |
|
|
1518 |
} |
} |
1519 |
|
|
1520 |
|
sub encode_uri_component ($) { |
1521 |
|
require Encode; |
1522 |
|
my $s = Encode::encode ('utf8', shift); |
1523 |
|
$s =~ s/([^0-9A-Za-z_.~-])/sprintf '%%%02X', ord $1/ge; |
1524 |
|
return $s; |
1525 |
|
} # encode_uri_component |
1526 |
|
|
1527 |
|
sub get_cc_uri ($) { |
1528 |
|
return './?uri=' . encode_uri_component ($_[0]); |
1529 |
|
} # get_cc_uri |
1530 |
|
|
1531 |
sub get_input_document ($$) { |
sub get_input_document ($$) { |
1532 |
my ($http, $dom) = @_; |
my ($http, $dom) = @_; |
1533 |
|
|