];
push @nav, ['#parse-errors' => 'Parse Error'] unless $input->{nested};
my $onerror = sub {
my (%opt) = @_;
my ($type, $cls, $msg) = get_text ($opt{type}, $opt{level});
- if ($opt{column} > 0) {
- print STDOUT qq[- Line $opt{line} column $opt{column}
\n];
- } else {
- $opt{line} = $opt{line} - 1 || 1;
- print STDOUT qq[- Line $opt{line}
\n];
- }
+ print STDOUT qq[- ], get_error_label ($input, \%opt),
+ qq[
];
$type =~ tr/ /-/;
$type =~ s/\|/%7C/g;
$msg .= qq[ [Description]];
@@ -319,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})
@@ -350,7 +361,7 @@
];
return $elements;
} # print_structure_error_dom_section
@@ -931,16 +973,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};
}
@@ -993,6 +1034,106 @@
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[
+];
+} # print_uri_section
+
+sub print_rdf_section ($$$) {
+ my ($input, $rdfs) = @_;
+
+ push @nav, ['#' . $input->{id_prefix} . 'rdf' => 'RDF']
+ unless $input->{nested};
+ print STDOUT qq[
+];
+} # print_rdf_section
+
+sub get_rdf_resource_html ($) {
+ my $resource = shift;
+ if (defined $resource->{uri}) {
+ my $euri = htescape ($resource->{uri});
+ return '<' . $euri .
+ '>';
+ } elsif (defined $resource->{bnodeid}) {
+ return htescape ('_:' . $resource->{bnodeid});
+ } elsif ($resource->{nodes}) {
+ return '(rdf:XMLLiteral)';
+ } elsif (defined $resource->{value}) {
+ my $elang = htescape (defined $resource->{language}
+ ? $resource->{language} : '');
+ my $r = qq[] . htescape ($resource->{value}) . '
';
+ if (defined $resource->{datatype}) {
+ my $euri = htescape ($resource->{datatype});
+ $r .= '^^<' . $euri .
+ '>';
+ } elsif (length $resource->{language}) {
+ $r .= '@' . htescape ($resource->{language});
+ }
+ return $r;
+ } else {
+ return '??';
+ }
+} # get_rdf_resource_html
+
sub print_result_section ($) {
my $result = shift;
@@ -1058,24 +1199,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[
- | | Semantics | 0? | 0? | 0? | −∞..$score_base |
|---|
+| Semantics | 0? | 0? | 0? | −∞..$score_base / 20
|
|---|
| Total |
$must_error? |
$should_error? |
$warning? |
-−∞..$score_max |
|---|
+−∞..$score_max / 100
Important: This conformance checking service
@@ -1122,18 +1264,49 @@
my $r = '';
- if (defined $err->{line}) {
- if ($err->{column} > 0) {
- $r = qq[Line $err->{line} column $err->{column}];
+ my $line;
+ my $column;
+
+ if (defined $err->{node}) {
+ $line = $err->{node}->get_user_data ('manakai_source_line');
+ if (defined $line) {
+ $column = $err->{node}->get_user_data ('manakai_source_column');
} else {
- $err->{line} = $err->{line} - 1 || 1;
- $r = qq[Line $err->{line}];
+ if ($err->{node}->node_type == $err->{node}->ATTRIBUTE_NODE) {
+ my $owner = $err->{node}->owner_element;
+ $line = $owner->get_user_data ('manakai_source_line');
+ $column = $owner->get_user_data ('manakai_source_column');
+ } else {
+ my $parent = $err->{node}->parent_node;
+ if ($parent) {
+ $line = $parent->get_user_data ('manakai_source_line');
+ $column = $parent->get_user_data ('manakai_source_column');
+ }
+ }
+ }
+ }
+ unless (defined $line) {
+ if (defined $err->{token} and defined $err->{token}->{line}) {
+ $line = $err->{token}->{line};
+ $column = $err->{token}->{column};
+ } elsif (defined $err->{line}) {
+ $line = $err->{line};
+ $column = $err->{column};
+ }
+ }
+
+ if (defined $line) {
+ if (defined $column and $column > 0) {
+ $r = qq[Line $line column $column];
+ } else {
+ $line = $line - 1 || 1;
+ $r = qq[Line $line];
}
}
if (defined $err->{node}) {
$r .= ' ' if length $r;
- $r = get_node_link ($input, $err->{node});
+ $r .= get_node_link ($input, $err->{node});
}
if (defined $err->{index}) {
@@ -1187,10 +1360,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 . '"';
@@ -1268,6 +1441,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) = @_;
@@ -1457,4 +1641,4 @@
=cut
-## $Date: 2008/02/24 02:17:51 $
+## $Date: 2008/05/18 03:47:56 $
|