--- test/html-webhacc/WebHACC/Result.pm 2008/07/20 14:58:24 1.1 +++ test/html-webhacc/WebHACC/Result.pm 2008/08/02 06:07:11 1.7 @@ -5,27 +5,72 @@ return bless {}, shift; } # new +sub output ($;$) { + if (@_ > 1) { + if (defined $_[1]) { + $_[0]->{output} = $_[1]; + } else { + delete $_[0]->{output}; + } + } + + return $_[0]->{output}; +} # output + +sub add_error ($%) { + my ($self, %opt) = @_; + + my $out = $self->output; -sub get_error_label ($$) { - my $self = shift; - my ($input, $err) = @_; + 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 $r = ''; + my $error_type_text = $opt{type}; + + my $class = qq[level-$error_level layer-$error_layer]; + + ## Line & column numbers (prepare values) 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'); - } 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'); + $column = $opt{node}->get_user_data ('manakai_source_column'); + } elsif ($opt{node}->isa ('Message::IF::Node')) { + 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,110 +79,253 @@ } } 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}; } } + $line = $line - 1 || 1 + if defined $line and not (defined $column and $column > 0); + + $out->start_tag ('dt', class => $class, + 'data-type' => $opt{type}, + 'data-level' => $error_level, + 'data-layer' => $error_layer, + ($line ? ('data-line' => $line) : ()), + ($column ? ('data-column' => $column) : ())); + my $has_location; + + ## URL + + if (defined $opt{url}) { + $out->url ($opt{url}); + $has_location = 1; + } + + ## Line & column numbers (real output) if (defined $line) { if (defined $column and $column > 0) { - $r = qq[Line $line column $column]; + $out->xref ('Line #', text => $line, target => 'line-' . $line); + $out->text (' '); + $out->nl_text ('column #', text => $column); } else { - $line = $line - 1 || 1; - $r = qq[Line $line]; + $out->xref ('Line #', text => $line, target => 'line-' . $line); } + $has_location = 1; } - 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}); + $has_location = 1; } - 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 #', text => (0+$opt{index}), + target => 'index-' . (0+$opt{index})); } else { - $r .= "Index " - . (0+$err->{index}) . ''; + $out->html (' '); + $out->nl_text ('Index #', text => (0+$opt{index})); } + $has_location = 1; + } + + if (defined $opt{value}) { + $out->html (' '); + $out->code ($opt{value}); + $has_location = 1; } - if (defined $err->{value}) { - $r .= ' ' if length $r; ## BUG: v must be escaped - $r .= '' . ($err->{value}) . ''; - } - - return $r; -} # get_error_label - -sub get_error_level_label ($) { - my $self = shift; - my $err = shift; - - my $r = ''; - - if (not defined $err->{level} or $err->{level} eq 'm') { - $r = qq[MUST-level - error: ]; - } elsif ($err->{level} eq 's') { - $r = qq[SHOULD-level - error: ]; - } elsif ($err->{level} eq 'w') { - $r = qq[Warning: - ]; - } elsif ($err->{level} eq 'u' or $err->{level} eq 'unsupported') { - $r = qq[Not - supported: ]; - } elsif ($err->{level} eq 'i') { - $r = qq[Information: ]; + unless ($has_location) { + if (defined $opt{input}) { + if (defined $opt{input}->{container_node}) { + my $original_input = $out->input; + $out->input ($opt{input}->{parent_input}); + $out->node_link ($opt{input}->{container_node}); + $out->input ($original_input); + $has_location = 1; + } elsif (defined $opt{input}->{request_uri}) { + $out->url ($opt{input}->{request_uri}); + $has_location = 1; + } elsif (defined $opt{input}->{uri}) { + $out->url ($opt{input}->{uri}); + $has_location = 1; + } + } + + unless ($has_location) { + $out->text ('Unknown location'); + } + } + + $out->start_tag ('dd', class => $class); + + ## Error level + + if ($error_level eq 'm') { + $out->html (qq[MUST-level + error: ]); + } elsif ($error_level eq 's') { + $out->html (qq[SHOULD-level + error: ]); + } elsif ($error_level eq 'w') { + $out->html (qq[Warning: ]); + } elsif ($error_level eq 'u') { + $out->html (qq[Not + supported: ]); + } elsif ($error_level eq 'i') { + $out->html (qq[Information: ]); + } + + ## Error message + + $out->nl_text ($error_type_text, node => $opt{node}, text => $opt{text}); + + ## Additional error description + + if (defined $opt{text}) { + $out->html (' ('); + $out->text ($opt{text}); + $out->html (')'); + } + + ## Link to a long description + + my $fragment = $opt{type}; + $fragment =~ tr/ /-/; + $fragment = $out->encode_url_component ($fragment); + $out->text (' ['); + $out->link ('Description', url => '../error-description#' . $fragment, + rel => 'help'); + $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 { - my $elevel = htescape ($err->{level}); - $r = qq[$elevel: - ]; - } - - return $r; -} # get_error_level_label - -sub get_node_path ($) { - my $self = shift; - my $node = shift; - my @r; - while (defined $node) { - my $rs; - if ($node->node_type == 1) { - $rs = $node->node_name; - $node = $node->parent_node; - } elsif ($node->node_type == 2) { - $rs = '@' . $node->node_name; - $node = $node->owner_element; - } elsif ($node->node_type == 3) { - $rs = '"' . $node->data . '"'; - $node = $node->parent_node; - } elsif ($node->node_type == 9) { - @r = ('') unless @r; - $rs = ''; - $node = $node->parent_node; + $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 { - $rs = '#' . $node->node_type; - $node = $node->parent_node; + $out->html (qq[$result->{$_->[1]}->{score_min}]); } - unshift @r, $rs; + $out->html (qq[ / 20]); } - return join '/', @r; -} # get_node_path -use Scalar::Util qw/refaddr/; - -sub get_node_link ($$) { - my $self = shift; - return qq[] . - ($self->get_node_path ($_[1])) . qq[]; - ## BUG: ^ must be escaped -} # get_node_link + $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 1;