/[suikacvs]/test/html-webhacc/WebHACC/Result.pm
Suika

Contents of /test/html-webhacc/WebHACC/Result.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.7 - (hide annotations) (download)
Sat Aug 2 06:07:11 2008 UTC (16 years, 4 months ago) by wakaba
Branch: MAIN
Changes since 1.6: +1 -1 lines
++ html/WebHACC/Language/ChangeLog	2 Aug 2008 06:07:07 -0000
2008-08-02  Wakaba  <wakaba@suika.fam.cx>

	* WebIDL.pm (generate_structure_error_section): New method.

++ html/WebHACC/ChangeLog	2 Aug 2008 06:06:40 -0000
2008-08-02  Wakaba  <wakaba@suika.fam.cx>

	* Output.pm ($htescape_value): New code.  Some methods should
	invoke this code instead of original $htescape, since that
	code will convert invisible characters into HTML tags
	such that that code is not suitable for attribute values
	and CDATA/PCDATA element contents.
	($get_object_path): New.  Future revision of this code should
	support real "path" to the node object.  The current version
	only dumps the type and the name of the node itself.
	(node_link): Support for non-DOM nodes.

	* Result.pm (add_error): Support for non-DOM nodes.

1 wakaba 1.1 package WebHACC::Result;
2     use strict;
3    
4     sub new ($) {
5     return bless {}, shift;
6     } # new
7    
8 wakaba 1.2 sub output ($;$) {
9     if (@_ > 1) {
10     if (defined $_[1]) {
11     $_[0]->{output} = $_[1];
12     } else {
13     delete $_[0]->{output};
14     }
15     }
16    
17     return $_[0]->{output};
18     } # output
19    
20     sub add_error ($%) {
21     my ($self, %opt) = @_;
22    
23     my $out = $self->output;
24    
25     my $error_level = $opt{level};
26     if (not defined $error_level) {
27     $error_level = 'm'; ## NOTE: Unknown - an error of the implementation
28     } elsif ({
29     m => 1, s => 1, w => 1, i => 1, u => 1,
30     }->{$error_level}) {
31     #
32     } else {
33     $error_level = 'm'; ## NOTE: Unknown - an error of the implementation
34     }
35    
36     my $error_layer = $opt{layer};
37     if (not defined $error_layer) {
38     $error_layer = 'syntax'; ## NOTE: Unknown - an error of the implementation
39     } elsif ({
40     transfer => 1,
41     encode => 1,
42     charset => 1,
43     syntax => 1,
44     structure => 1,
45     semantics => 1,
46     }->{$error_layer}) {
47     #
48     } else {
49     $error_layer = 'syntax'; ## NOTE: Unknown - an error of the implementation
50     }
51    
52     my $error_type_text = $opt{type};
53    
54     my $class = qq[level-$error_level layer-$error_layer];
55    
56 wakaba 1.6 ## Line & column numbers (prepare values)
57 wakaba 1.1
58     my $line;
59     my $column;
60    
61 wakaba 1.2 if (defined $opt{node}) {
62     $line = $opt{node}->get_user_data ('manakai_source_line');
63 wakaba 1.1 if (defined $line) {
64 wakaba 1.2 $column = $opt{node}->get_user_data ('manakai_source_column');
65 wakaba 1.7 } elsif ($opt{node}->isa ('Message::IF::Node')) {
66 wakaba 1.2 if ($opt{node}->node_type == $opt{node}->ATTRIBUTE_NODE) {
67     my $owner = $opt{node}->owner_element;
68     if ($owner) {
69     $line = $owner->get_user_data ('manakai_source_line');
70     $column = $owner->get_user_data ('manakai_source_column');
71     }
72 wakaba 1.1 } else {
73 wakaba 1.2 my $parent = $opt{node}->parent_node;
74 wakaba 1.1 if ($parent) {
75     $line = $parent->get_user_data ('manakai_source_line');
76     $column = $parent->get_user_data ('manakai_source_column');
77     }
78     }
79     }
80     }
81     unless (defined $line) {
82 wakaba 1.2 if (defined $opt{token} and defined $opt{token}->{line}) {
83     $line = $opt{token}->{line};
84     $column = $opt{token}->{column};
85     } elsif (defined $opt{line}) {
86     $line = $opt{line};
87     $column = $opt{column};
88 wakaba 1.1 }
89     }
90 wakaba 1.6 $line = $line - 1 || 1
91     if defined $line and not (defined $column and $column > 0);
92    
93     $out->start_tag ('dt', class => $class,
94     'data-type' => $opt{type},
95     'data-level' => $error_level,
96     'data-layer' => $error_layer,
97     ($line ? ('data-line' => $line) : ()),
98     ($column ? ('data-column' => $column) : ()));
99     my $has_location;
100    
101     ## URL
102    
103     if (defined $opt{url}) {
104     $out->url ($opt{url});
105     $has_location = 1;
106     }
107    
108     ## Line & column numbers (real output)
109 wakaba 1.1
110     if (defined $line) {
111     if (defined $column and $column > 0) {
112 wakaba 1.6 $out->xref ('Line #', text => $line, target => 'line-' . $line);
113     $out->text (' ');
114     $out->nl_text ('column #', text => $column);
115 wakaba 1.1 } else {
116 wakaba 1.6 $out->xref ('Line #', text => $line, target => 'line-' . $line);
117 wakaba 1.1 }
118 wakaba 1.3 $has_location = 1;
119 wakaba 1.1 }
120    
121 wakaba 1.2 ## Node path
122    
123     if (defined $opt{node}) {
124     $out->html (' ');
125     $out->node_link ($opt{node});
126 wakaba 1.3 $has_location = 1;
127 wakaba 1.1 }
128    
129 wakaba 1.2 if (defined $opt{index}) {
130     if ($opt{index_has_link}) {
131     $out->html (' ');
132 wakaba 1.6 $out->xref ('Index #', text => (0+$opt{index}),
133 wakaba 1.2 target => 'index-' . (0+$opt{index}));
134 wakaba 1.1 } else {
135 wakaba 1.6 $out->html (' ');
136     $out->nl_text ('Index #', text => (0+$opt{index}));
137 wakaba 1.1 }
138 wakaba 1.3 $has_location = 1;
139 wakaba 1.1 }
140    
141 wakaba 1.2 if (defined $opt{value}) {
142     $out->html (' ');
143     $out->code ($opt{value});
144 wakaba 1.3 $has_location = 1;
145     }
146    
147     unless ($has_location) {
148     if (defined $opt{input}) {
149     if (defined $opt{input}->{container_node}) {
150     my $original_input = $out->input;
151     $out->input ($opt{input}->{parent_input});
152     $out->node_link ($opt{input}->{container_node});
153     $out->input ($original_input);
154     $has_location = 1;
155     } elsif (defined $opt{input}->{request_uri}) {
156     $out->url ($opt{input}->{request_uri});
157     $has_location = 1;
158     } elsif (defined $opt{input}->{uri}) {
159     $out->url ($opt{input}->{uri});
160     $has_location = 1;
161     }
162     }
163    
164     unless ($has_location) {
165 wakaba 1.5 $out->text ('Unknown location');
166 wakaba 1.3 }
167 wakaba 1.1 }
168 wakaba 1.2
169     $out->start_tag ('dd', class => $class);
170 wakaba 1.4
171     ## Error level
172    
173     if ($error_level eq 'm') {
174     $out->html (qq[<strong><a href="../error-description#level-m"><em class=rfc2119>MUST</em>-level
175     error</a></strong>: ]);
176     } elsif ($error_level eq 's') {
177     $out->html (qq[<strong><a href="../error-description#level-s"><em class=rfc2119>SHOULD</em>-level
178     error</a></strong>: ]);
179     } elsif ($error_level eq 'w') {
180     $out->html (qq[<strong><a href="../error-description#level-w">Warning</a></strong>: ]);
181     } elsif ($error_level eq 'u') {
182     $out->html (qq[<strong><a href="../error-description#level-u">Not
183     supported</a></strong>: ]);
184     } elsif ($error_level eq 'i') {
185     $out->html (qq[<strong><a href="../error-description#level-i">Information</a></strong>: ]);
186     }
187    
188     ## Error message
189    
190 wakaba 1.6 $out->nl_text ($error_type_text, node => $opt{node}, text => $opt{text});
191 wakaba 1.2
192 wakaba 1.4 ## Additional error description
193    
194 wakaba 1.2 if (defined $opt{text}) {
195     $out->html (' (<q>');
196     $out->text ($opt{text});
197     $out->html ('</q>)');
198     }
199 wakaba 1.4
200     ## Link to a long description
201 wakaba 1.2
202     my $fragment = $opt{type};
203     $fragment =~ tr/ /-/;
204     $fragment = $out->encode_url_component ($fragment);
205     $out->text (' [');
206 wakaba 1.4 $out->link ('Description', url => '../error-description#' . $fragment,
207     rel => 'help');
208 wakaba 1.2 $out->text (']');
209    
210    
211     # my ($type, $cls, $msg) = main::get_text ($opt{type}, $opt{level});
212     # $out->html (qq[<dt class="$cls">] . $result->get_error_label ($input, \%opt));
213    
214     $error_layer = 'char'
215     if $error_layer eq 'charset' or $error_layer eq 'encode';
216     if ($error_level eq 's') {
217     $self->{$error_layer}->{should}++;
218     $self->{$error_layer}->{score_min} -= 2;
219     $self->{conforming_min} = 0;
220     } elsif ($error_level eq 'w') {
221     $self->{$error_layer}->{warning}++;
222     } elsif ($error_level eq 'u') {
223     $self->{$error_layer}->{unsupported}++;
224     $self->{unsupported} = 1;
225     } elsif ($error_level eq 'i') {
226     #
227     } else {
228     $self->{$error_layer}->{must}++;
229     $self->{$error_layer}->{score_max} -= 2;
230     $self->{$error_layer}->{score_min} -= 2;
231     $self->{conforming_min} = 0;
232     $self->{conforming_max} = 0;
233     }
234     } # add_error
235    
236     sub generate_result_section ($) {
237     my $result = shift;
238    
239     my $out = $result->output;
240    
241     $out->start_section (id => 'result-summary',
242     title => 'Result');
243    
244     if ($result->{unsupported} and $result->{conforming_max}) {
245     $out->html (qq[<p class=uncertain id=result-para>The conformance
246     checker cannot decide whether the document is conforming or
247     not, since the document contains one or more unsupported
248     features. The document might or might not be conforming.</p>]);
249     } elsif ($result->{conforming_min}) {
250     $out->html (qq[<p class=PASS id=result-para>No conformance-error is
251     found in this document.</p>]);
252     } elsif ($result->{conforming_max}) {
253     $out->html (qq[<p class=SEE-RESULT id=result-para>This document
254     is <strong>likely <em>non</em>-conforming</strong>, but in rare case
255     it might be conforming.</p>]);
256     } else {
257     $out->html (qq[<p class=FAIL id=result-para>This document is
258     <strong><em>non</em>-conforming</strong>.</p>]);
259     }
260    
261     $out->html (qq[<table>
262     <colgroup><col><colgroup><col><col><col><colgroup><col>
263     <thead>
264     <tr><th scope=col></th>
265     <th scope=col><a href="../error-description#level-m"><em class=rfc2119>MUST</em>-level
266     Errors</a></th>
267     <th scope=col><a href="../error-description#level-s"><em class=rfc2119>SHOULD</em>-level
268     Errors</a></th>
269     <th scope=col><a href="../error-description#level-w">Warnings</a></th>
270     <th scope=col>Score</th></tr></thead><tbody>]);
271    
272     ## TODO: Introduce "N/A" value (e.g. Character layer is not applicable
273     ## to binary formats)
274    
275     my $must_error = 0;
276     my $should_error = 0;
277     my $warning = 0;
278     my $score_min = 0;
279     my $score_max = 0;
280     my $score_base = 20;
281     my $score_unit = $score_base / 100;
282     for (
283     [Transfer => 'transfer', ''],
284     [Character => 'char', ''],
285     [Syntax => 'syntax', '#parse-errors'],
286     [Structure => 'structure', '#document-errors'],
287     ) {
288     $must_error += ($result->{$_->[1]}->{must} += 0);
289     $should_error += ($result->{$_->[1]}->{should} += 0);
290     $warning += ($result->{$_->[1]}->{warning} += 0);
291     $score_min += (($result->{$_->[1]}->{score_min} *= $score_unit) += $score_base);
292     $score_max += (($result->{$_->[1]}->{score_max} *= $score_unit) += $score_base);
293    
294     my $uncertain = $result->{$_->[1]}->{unsupported} ? '?' : '';
295     my $label = $_->[0];
296     if ($result->{$_->[1]}->{must} or
297     $result->{$_->[1]}->{should} or
298     $result->{$_->[1]}->{warning} or
299     $result->{$_->[1]}->{unsupported}) {
300     $label = qq[<a href="$_->[2]">$label</a>];
301     }
302    
303     $out->html (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>]);
304     if ($uncertain) {
305     $out->html (qq[<td class="@{[$result->{$_->[1]}->{must} ? 'FAIL' : $result->{$_->[1]}->{should} ? 'SEE-RESULT' : '']}">&#x2212;&#x221E;..$result->{$_->[1]}->{score_max}]);
306     } elsif ($result->{$_->[1]}->{score_min} != $result->{$_->[1]}->{score_max}) {
307     $out->html (qq[<td class="@{[$result->{$_->[1]}->{must} ? 'FAIL' : 'SEE-RESULT']}">$result->{$_->[1]}->{score_min}..$result->{$_->[1]}->{score_max}]);
308     } else {
309     $out->html (qq[<td class="@{[$result->{$_->[1]}->{must} ? 'FAIL' : '']}">$result->{$_->[1]}->{score_min}]);
310     }
311     $out->html (qq[ / 20]);
312     }
313    
314     $score_max += $score_base;
315    
316     $out->html (qq[
317     <tr class=uncertain><th scope=row>Semantics</th><td>0?</td><td>0?</td><td>0?</td><td>&#x2212;&#x221E;..$score_base / 20
318     </tbody>
319     <tfoot><tr class=uncertain><th scope=row>Total</th>
320     <td class="@{[$must_error ? 'FAIL' : '']}">$must_error?</td>
321     <td class="@{[$should_error ? 'SEE-RESULT' : '']}">$should_error?</td>
322     <td>$warning?</td>
323     <td class="@{[$must_error ? 'FAIL' : $should_error ? 'SEE-RESULT' : '']}"><strong>&#x2212;&#x221E;..$score_max</strong> / 100
324     </table>
325    
326     <p><strong>Important</strong>: This conformance checking service
327     is <em>under development</em>. The result above might be <em>wrong</em>.</p>]);
328     $out->end_section;
329     } # generate_result_section
330 wakaba 1.1
331     1;

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24