--- test/html-webhacc/WebHACC/Result.pm 2008/07/20 14:58:24 1.1 +++ test/html-webhacc/WebHACC/Result.pm 2008/07/20 16:53:10 1.2 @@ -5,27 +5,80 @@ return bless {}, shift; } # new +sub output ($;$) { + if (@_ > 1) { + if (defined $_[1]) { + $_[0]->{output} = $_[1]; + } else { + delete $_[0]->{output}; + } + } -sub get_error_label ($$) { - my $self = shift; - my ($input, $err) = @_; + return $_[0]->{output}; +} # output + +sub add_error ($%) { + my ($self, %opt) = @_; + + my $out = $self->output; + + my $error_level = $opt{level}; + if (not defined $error_level) { + $error_level = 'm'; ## NOTE: Unknown - an error of the implementation + } elsif ({ + m => 1, s => 1, w => 1, i => 1, u => 1, + }->{$error_level}) { + # + } else { + $error_level = 'm'; ## NOTE: Unknown - an error of the implementation + } + + my $error_layer = $opt{layer}; + if (not defined $error_layer) { + $error_layer = 'syntax'; ## NOTE: Unknown - an error of the implementation + } elsif ({ + transfer => 1, + encode => 1, + charset => 1, + syntax => 1, + structure => 1, + semantics => 1, + }->{$error_layer}) { + # + } else { + $error_layer = 'syntax'; ## NOTE: Unknown - an error of the implementation + } + + my $error_type_text = $opt{type}; - my $r = ''; + my $class = qq[level-$error_level layer-$error_layer]; + + $out->start_tag ('dt', class => $class); + + ## URL + + if (defined $opt{url}) { + $out->url ($opt{url}); + } + + ## Line & column number my $line; my $column; - if (defined $err->{node}) { - $line = $err->{node}->get_user_data ('manakai_source_line'); + if (defined $opt{node}) { + $line = $opt{node}->get_user_data ('manakai_source_line'); if (defined $line) { - $column = $err->{node}->get_user_data ('manakai_source_column'); + $column = $opt{node}->get_user_data ('manakai_source_column'); } else { - 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'); + if ($opt{node}->node_type == $opt{node}->ATTRIBUTE_NODE) { + my $owner = $opt{node}->owner_element; + if ($owner) { + $line = $owner->get_user_data ('manakai_source_line'); + $column = $owner->get_user_data ('manakai_source_column'); + } } else { - my $parent = $err->{node}->parent_node; + my $parent = $opt{node}->parent_node; if ($parent) { $line = $parent->get_user_data ('manakai_source_line'); $column = $parent->get_user_data ('manakai_source_column'); @@ -34,44 +87,189 @@ } } 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 $opt{token} and defined $opt{token}->{line}) { + $line = $opt{token}->{line}; + $column = $opt{token}->{column}; + } elsif (defined $opt{line}) { + $line = $opt{line}; + $column = $opt{column}; } } if (defined $line) { if (defined $column and $column > 0) { - $r = qq[Line $line column $column]; + $out->xref ('Line ' . $line, target => 'line-' . $line); + $out->text (' column ' . $column); } else { $line = $line - 1 || 1; - $r = qq[Line $line]; + $out->xref ('Line ' . $line, target => 'line-' . $line); } } - if (defined $err->{node}) { - $r .= ' ' if length $r; - $r .= $self->get_node_link ($input, $err->{node}); + ## Node path + + if (defined $opt{node}) { + $out->html (' '); + $out->node_link ($opt{node}); } - if (defined $err->{index}) { - if (length $r) { - $r .= ', Index ' . (0+$err->{index}); + if (defined $opt{index}) { + if ($opt{index_has_link}) { + $out->html (' '); + $out->xref ('Index ' . (0+$opt{index}), + target => 'index-' . (0+$opt{index})); } else { - $r .= "Index " - . (0+$err->{index}) . ''; + $out->text (' Index ' . (0+$opt{index})); } } - if (defined $err->{value}) { - $r .= ' ' if length $r; ## BUG: v must be escaped - $r .= '' . ($err->{value}) . ''; + if (defined $opt{value}) { + $out->html (' '); + $out->code ($opt{value}); } + + $out->start_tag ('dd', class => $class); + $out->text ($error_type_text); + + if (defined $opt{text}) { + $out->html (' ('); + $out->text ($opt{text}); + $out->html (')'); + } + + my $fragment = $opt{type}; + $fragment =~ tr/ /-/; + $fragment = $out->encode_url_component ($fragment); + $out->text (' ['); + $out->link ('Description', url => '../error-description#' . $fragment); + $out->text (']'); + + +# my ($type, $cls, $msg) = main::get_text ($opt{type}, $opt{level}); +# $out->html (qq[
] . $result->get_error_label ($input, \%opt)); + + $error_layer = 'char' + if $error_layer eq 'charset' or $error_layer eq 'encode'; + if ($error_level eq 's') { + $self->{$error_layer}->{should}++; + $self->{$error_layer}->{score_min} -= 2; + $self->{conforming_min} = 0; + } elsif ($error_level eq 'w') { + $self->{$error_layer}->{warning}++; + } elsif ($error_level eq 'u') { + $self->{$error_layer}->{unsupported}++; + $self->{unsupported} = 1; + } elsif ($error_level eq 'i') { + # + } else { + $self->{$error_layer}->{must}++; + $self->{$error_layer}->{score_max} -= 2; + $self->{$error_layer}->{score_min} -= 2; + $self->{conforming_min} = 0; + $self->{conforming_max} = 0; + } +} # add_error + +sub generate_result_section ($) { + my $result = shift; + + my $out = $result->output; + + $out->start_section (id => 'result-summary', + title => 'Result'); + + if ($result->{unsupported} and $result->{conforming_max}) { + $out->html (qq[

The conformance + checker cannot decide whether the document is conforming or + not, since the document contains one or more unsupported + features. The document might or might not be conforming.

]); + } elsif ($result->{conforming_min}) { + $out->html (qq[

No conformance-error is + found in this document.

]); + } elsif ($result->{conforming_max}) { + $out->html (qq[

This document + is likely non-conforming, but in rare case + it might be conforming.

]); + } else { + $out->html (qq[

This document is + non-conforming.

]); + } + + $out->html (qq[ ++ + + + + +]); + + ## TODO: Introduce "N/A" value (e.g. Character layer is not applicable + ## to binary formats) + + my $must_error = 0; + my $should_error = 0; + my $warning = 0; + my $score_min = 0; + my $score_max = 0; + my $score_base = 20; + my $score_unit = $score_base / 100; + for ( + [Transfer => 'transfer', ''], + [Character => 'char', ''], + [Syntax => 'syntax', '#parse-errors'], + [Structure => 'structure', '#document-errors'], + ) { + $must_error += ($result->{$_->[1]}->{must} += 0); + $should_error += ($result->{$_->[1]}->{should} += 0); + $warning += ($result->{$_->[1]}->{warning} += 0); + $score_min += (($result->{$_->[1]}->{score_min} *= $score_unit) += $score_base); + $score_max += (($result->{$_->[1]}->{score_max} *= $score_unit) += $score_base); + + my $uncertain = $result->{$_->[1]}->{unsupported} ? '?' : ''; + my $label = $_->[0]; + if ($result->{$_->[1]}->{must} or + $result->{$_->[1]}->{should} or + $result->{$_->[1]}->{warning} or + $result->{$_->[1]}->{unsupported}) { + $label = qq[$label]; + } + + $out->html (qq[]); + if ($uncertain) { + $out->html (qq[ + + + + +
MUST-level +ErrorsSHOULD-level +ErrorsWarningsScore
$label$result->{$_->[1]}->{must}$uncertain$result->{$_->[1]}->{should}$uncertain$result->{$_->[1]}->{warning}$uncertain−∞..$result->{$_->[1]}->{score_max}]); + } elsif ($result->{$_->[1]}->{score_min} != $result->{$_->[1]}->{score_max}) { + $out->html (qq[$result->{$_->[1]}->{score_min}..$result->{$_->[1]}->{score_max}]); + } else { + $out->html (qq[$result->{$_->[1]}->{score_min}]); + } + $out->html (qq[ / 20]); + } + + $score_max += $score_base; + + $out->html (qq[ +
Semantics0?0?0?−∞..$score_base / 20 +
Total$must_error?$should_error?$warning?−∞..$score_max / 100 +
+ +

Important: This conformance checking service +is under development. The result above might be wrong.

]); + $out->end_section; +} # generate_result_section + +sub _get_error_label ($$) { + my $self = shift; + my ($input, $err) = @_; + - return $r; } # get_error_label sub get_error_level_label ($) {