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

Contents of /test/html-webhacc/WebHACC/Language/DOM.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.7 - (show annotations) (download)
Thu Aug 14 15:50:42 2008 UTC (17 years ago) by wakaba
Branch: MAIN
Changes since 1.6: +3 -0 lines
++ ChangeLog	14 Aug 2008 15:42:17 -0000
	* cc.cgi: Generate result summary sections for
	each subdocument.

	* error-description-source.xml: New entries to
	support localization of result sections.

2008-08-14  Wakaba  <wakaba@suika.fam.cx>

	* cc-style.css: Support for revised version of result summary
	section styling.

2008-08-14  Wakaba  <wakaba@suika.fam.cx>

++ html/WebHACC/Language/ChangeLog	14 Aug 2008 15:50:38 -0000
	* Base.pm, CSS.pm, CacheManifest.pm, DOM.pm, Default.pm,
	HTML.pm, WebIDL.pm, XML.pm: Set |layer_applicable|
	or |layer_uncertain| flag appropriately.

2008-08-14  Wakaba  <wakaba@suika.fam.cx>

++ html/WebHACC/ChangeLog	14 Aug 2008 15:48:38 -0000
	* Input.pm: Methods |generate_transfer_sections|
	and |generate_http_header_section| are moved to HTTP
	subclass, since they are irrelevant to non-HTTP inputs.
	(_get_document): Forbidden host error was not represented
	by WebHACC::Input::Error subclass.
	(WebHACC::Input::Error generate_transfer_sections): Use
	role name for the section.
	(WebHACC::Input::HTTPError generate_transfer_sections): New method
	added, since the main superclass, i.e. WebHACC::Input::Error,
	no longer dumps HTTP headers due to the change mentioned above.

	* Output.pm (start_section): New roles "transfer-errors" and "result".

	* Result.pm (parent_result): New attribute.
	(layer_applicable, layer_uncertain): New methods to set flags.
	(add_error): Natural language strings are now handled
	by the catalog mechanism.  Use new scoring mechanism.
	(generate_result_section): Use catalog for all natural
	language strings.  Table generation is now much more sophiscated
	that it was.  Support for subdoc result summary.  Support
	for the column of the number of informational message.  Support
	for "N/A" status.

2008-08-14  Wakaba  <wakaba@suika.fam.cx>

1 package WebHACC::Language::DOM;
2 use strict;
3 require WebHACC::Language::Base;
4 push our @ISA, 'WebHACC::Language::Base';
5
6 use Scalar::Util qw[refaddr];
7
8 sub generate_structure_dump_section ($) {
9 my $self = shift;
10
11 my $out = $self->output;
12
13 $out->start_section (role => 'tree');
14
15 $out->start_tag ('ol', class => 'xoxo');
16
17 my @node = ($self->{structure});
18 while (@node) {
19 my $child = shift @node;
20 unless (ref $child) {
21 $out->html ($child);
22 next;
23 }
24
25 my $node_id = 'node-'.refaddr $child;
26 my $nt = $child->node_type;
27 if ($nt == $child->ELEMENT_NODE) {
28 my $child_nsuri = $child->namespace_uri;
29 $out->start_tag ('li', id => $node_id, class => 'tree-element');
30 $out->start_tag ('code',
31 title => defined $child_nsuri ? $child_nsuri : '');
32 $out->text ($child->tag_name); ## TODO: case
33 $out->end_tag ('code');
34
35 if ($child->has_attributes) {
36 $out->start_tag ('ul', class => 'attributes');
37 for my $attr (sort {$a->[0] cmp $b->[0]} map { [$_->name, $_->value, $_->namespace_uri, 'node-'.refaddr $_] }
38 @{$child->attributes}) {
39 $out->start_tag ('li', id => $attr->[3], class => 'tree-attribute');
40 $out->start_tag ('code',
41 title => defined $attr->[2] ? $attr->[2] : '');
42 $out->html ($attr->[0]); ## ISSUE: case
43 $out->end_tag ('code');
44 $out->text (' = ');
45 $out->start_tag ('q');
46 $out->text ($attr->[1]); ## TODO: children
47 $out->end_tag ('q');
48 }
49 $out->end_tag ('ul');
50 }
51
52 if ($child->has_child_nodes) {
53 $out->start_tag ('ol', class => 'children');
54 unshift @node, @{$child->child_nodes}, '</ol></li>';
55 }
56 } elsif ($nt == $child->TEXT_NODE) {
57 $out->start_tag ('li', id => $node_id, class => 'tree-text');
58 $out->start_tag ('q', lang => '');
59 $out->text ($child->data);
60 $out->end_tag ('q');
61 } elsif ($nt == $child->CDATA_SECTION_NODE) {
62 $out->start_tag ('li', id => $node_id, class => 'tree-cdata');
63 $out->start_tag ('code');
64 $out->text ('<![CDATA[');
65 $out->end_tag ('code');
66 $out->start_tag ('q', lang => '');
67 $out->text ($child->data);
68 $out->end_tag ('q');
69 $out->start_tag ('code');
70 $out->text (']]>');
71 $out->end_tag ('code');
72 } elsif ($nt == $child->COMMENT_NODE) {
73 $out->start_tag ('li', id => $node_id, class => 'tree-cdata');
74 $out->start_tag ('code');
75 $out->text ('<!--');
76 $out->end_tag ('code');
77 $out->start_tag ('q', lang => '');
78 $out->text ($child->data);
79 $out->end_tag ('q');
80 $out->start_tag ('code');
81 $out->text ('-->');
82 $out->end_tag ('code');
83 } elsif ($nt == $child->DOCUMENT_NODE) {
84 $out->start_tag ('li', id => $node_id, class => 'tree-document');
85 $out->nl_text ('Document');
86
87 $out->start_tag ('ul', class => 'attributes');
88
89 my $cp = $child->manakai_charset;
90 if (defined $cp) {
91 $out->start_tag ('li');
92 $out->nl_text ('manakaiCharset');
93 $out->text (' = ');
94 $out->code ($cp);
95 }
96
97 $out->start_tag ('li');
98 $out->nl_text ('inputEncoding');
99 $out->text (' = ');
100 my $ie = $child->input_encoding;
101 if (defined $ie) {
102 $out->code ($ie);
103 if ($child->manakai_has_bom) {
104 $out->nl_text ('... with BOM');
105 }
106 } else {
107 $out->html (qq[(<code>null</code>)]);
108 }
109
110 $out->start_tag ('li');
111 $out->nl_text ('manakaiIsHTML:'.($child->manakai_is_html?1:0));
112
113 $out->start_tag ('li');
114 $out->nl_text ('manakaiCompatMode:'.$child->manakai_compat_mode);
115
116 unless ($child->manakai_is_html) {
117 $out->start_tag ('li');
118 $out->nl_text ('xmlVersion');
119 $out->text (' = ');
120 $out->code ($child->xml_version);
121
122 $out->start_tag ('li');
123 $out->nl_text ('xmlEncoding');
124 $out->text (' = ');
125 if (defined $child->xml_encoding) {
126 $out->code ($child->xml_encoding);
127 } else {
128 $out->html ('(<code>null</code>)');
129 }
130
131 $out->start_tag ('li');
132 $out->nl_text ('xmlStandalone');
133 $out->text (' = ');
134 $out->code ($child->xml_standalone ? 'true' : 'false');
135 }
136
137 $out->end_tag ('ul');
138
139 if ($child->has_child_nodes) {
140 $out->start_tag ('ol', class => 'children');
141 unshift @node, @{$child->child_nodes}, '</ol></li>';
142 }
143 } elsif ($nt == $child->DOCUMENT_TYPE_NODE) {
144 $out->start_tag ('li', id => $node_id, class => 'tree-doctype');
145 $out->code ('<!DOCTYPE>');
146 $out->start_tag ('ul', class => 'attributes');
147
148 $out->start_tag ('li', class => 'tree-doctype-name');
149 $out->text ('Name = ');
150 $out->code ($child->name);
151
152 $out->start_tag ('li', class => 'tree-doctype-publicid');
153 $out->text ('Public identifier = ');
154 $out->code ($child->public_id);
155
156 $out->start_tag ('li', class => 'tree-doctype-systemid');
157 $out->text ('System identifier = ');
158 $out->code ($child->system_id);
159
160 $out->end_tag ('ul');
161 } elsif ($nt == $child->PROCESSING_INSTRUCTION_NODE) {
162 $out->start_tag ('li', id => $node_id, class => 'tree-id');
163 $out->code ('<?');
164 $out->code ($child->target);
165 $out->text (' ');
166 $out->code ($child->data);
167 $out->code ('?>');
168 } else { # error
169 $out->start_tag ('li', id => $node_id, class => 'tree-unknown');
170 $out->text ($child->node_type . ' ' . $child->node_name);
171 }
172 }
173 $out->end_tag ('ol');
174
175 $out->end_section;
176 } # generate_structure_dump_section
177
178 sub generate_structure_error_section ($) {
179 my $self = shift;
180
181 my $out = $self->output;
182 $out->start_section (role => 'structure-errors');
183 $out->start_error_list (role => 'structure-errors');
184 $self->result->layer_applicable ('structure');
185
186 my $input = $self->input;
187 my $result = $self->result;
188
189 require Whatpm::ContentChecker;
190 my $onerror = sub {
191 $result->add_error (@_, layer => 'structure');
192 };
193
194 my $onsubdoc = $self->onsubdoc;
195 if ($self->{structure}->node_type == $self->{structure}->ELEMENT_NODE) {
196 $self->{add_info} = Whatpm::ContentChecker->check_element
197 ($self->{structure}, $onerror, $onsubdoc);
198 } else {
199 $self->{add_info} = Whatpm::ContentChecker->check_document
200 ($self->{structure}, $onerror, $onsubdoc);
201 }
202
203 $out->end_error_list (role => 'structure-errors');
204 $out->end_section;
205
206 $self->result->layer_uncertain ('semantics');
207 } # generate_structure_error_section
208
209 sub generate_additional_sections ($) {
210 my $self = shift;
211 $self->SUPER::generate_additional_sections;
212
213 $self->generate_table_section;
214
215 $self->generate_listing_section (
216 key => 'id', id => 'identifiers',
217 short_title => 'IDs', title => 'Identifiers',
218 );
219 $self->generate_listing_section (
220 key => 'term', id => 'terms',
221 short_title => 'Terms', title => 'Terms',
222 );
223 $self->generate_listing_section (
224 key => 'class', id => 'classes',
225 short_title => 'Classes', title => 'Classes',
226 );
227
228 $self->generate_rdf_section;
229 } # generate_additional_sections
230
231 sub generate_table_section ($) {
232 my $self = shift;
233
234 my $tables = $self->{add_info}->{table} || [];
235 return unless @$tables;
236
237 my $out = $self->output;
238 $out->start_section (id => 'tables', short_title => 'Tables',
239 title => 'Tables Section');
240
241 $out->html (q[<!--[if IE]><script type="text/javascript" src="../excanvas.js"></script><![endif]-->
242 <script src="../table-script.js" type="text/javascript"></script>
243 <noscript>
244 <p><em>Structure of tables are visualized here if scripting is enabled.</em></p>
245 </noscript>]);
246
247 require JSON;
248
249 my $i = 0;
250 for my $table (@$tables) {
251 $i++;
252 my $index = $out->input->full_subdocument_index;
253 $index = $index ? $index . '.' . $i : $i;
254 $out->start_section (id => 'table-' . $i,
255 title => 'Table #',
256 text => $index);
257
258 $out->start_tag ('dl');
259 $out->dt ('Table Element');
260 $out->start_tag ('dd');
261 $out->node_link ($table->{element});
262 $out->end_tag ('dl');
263 delete $table->{element};
264
265 for (@{$table->{column_group}}, @{$table->{column}}, $table->{caption},
266 @{$table->{row}}) {
267 next unless $_;
268 delete $_->{element};
269 }
270
271 for (@{$table->{row_group}}) {
272 next unless $_;
273 next unless $_->{element};
274 $_->{type} = $_->{element}->manakai_local_name;
275 delete $_->{element};
276 }
277
278 for (@{$table->{cell}}) {
279 next unless $_;
280 for (@{$_}) {
281 next unless $_;
282 for (@$_) {
283 $_->{id} = refaddr $_->{element} if defined $_->{element};
284 delete $_->{element};
285 $_->{is_header} = $_->{is_header} ? 1 : 0;
286 }
287 }
288 }
289
290 my $id_prefix = $self->input->id_prefix;
291 $out->script (q[tableToCanvas (] .
292 JSON::objToJson ($table) .
293 q[, document.getElementById ('] . $id_prefix . 'table-' . $i . q[')] .
294 q[, '] . $id_prefix . q[');]);
295
296 $out->end_section;
297 }
298
299 $out->end_section;
300 } # generate_table_section
301
302 sub generate_listing_section ($%) {
303 my $self = shift;
304 my %opt = @_;
305
306 my $list = $self->{add_info}->{$opt{key}} || {};
307 return unless keys %$list;
308
309 my $out = $self->output;
310
311 $out->start_section (id => $opt{id},
312 title => $opt{title},
313 short_title => $opt{short_title});
314 $out->start_tag ('dl');
315
316 for my $id (sort {$a cmp $b} keys %$list) {
317 $out->start_tag ('dt');
318 $out->code ($id);
319 for (@{$list->{$id}}) {
320 $out->start_tag ('dd');
321 $out->node_link ($_);
322 }
323 }
324
325 $out->end_tag ('dl');
326 $out->end_section;
327 } # generate_listing_section
328
329 my $generate_rdf_resource_html = sub ($$) {
330 my ($resource, $out) = @_;
331
332 if (defined $resource->{uri}) {
333 $out->url ($resource->{uri});
334 } elsif (defined $resource->{bnodeid}) {
335 $out->text ('_:' . $resource->{bnodeid});
336 } elsif ($resource->{nodes}) {
337 $out->text ('(rdf:XMLLiteral)');
338 } elsif (defined $resource->{value}) {
339 $out->start_tag ('q',
340 lang => defined $resource->{language}
341 ? $resource->{language} : '');
342 $out->text ($resource->{value});
343 $out->end_tag ('q');
344
345 if (defined $resource->{datatype}) {
346 $out->text ('^^');
347 $out->url ($resource->{datatype});
348 } elsif (length $resource->{language}) {
349 $out->text ('@' . $resource->{language});
350 }
351 } else {
352 $out->text ('??'); ## NOTE: An error of the implementation.
353 }
354 }; # $generate_rdf_resource_html
355
356 ## TODO: Should we move this method to another module,
357 ## such as Base or RDF?
358 sub generate_rdf_section ($) {
359 my $self = shift;
360
361 my $list = $self->{add_info}->{rdf} || [];
362 return unless @$list;
363
364 my $out = $self->output;
365 $out->start_section (id => 'rdf', short_title => 'RDF',
366 title => 'RDF Triples');
367 $out->start_tag ('dl');
368
369 my $i = 0;
370 for my $rdf (@$list) {
371 $out->start_tag ('dt', id => 'rdf-' . $i++);
372 $out->node_link ($rdf->[0]);
373 $out->start_tag ('dd');
374 $out->start_tag ('dl');
375 for my $triple (@{$rdf->[1]}) {
376 $out->start_tag ('dt');
377 $out->node_link ($triple->[0]);
378 $out->start_tag ('dd');
379 $out->text ('Subject: ');
380 $generate_rdf_resource_html->($triple->[1] => $out);
381 $out->start_tag ('dd');
382 $out->text ('Predicate: ');
383 $generate_rdf_resource_html->($triple->[2] => $out);
384 $out->start_tag ('dd');
385 $out->text ('Object: ');
386 $generate_rdf_resource_html->($triple->[3] => $out);
387 }
388 $out->end_tag ('dl');
389 }
390 $out->end_tag ('dl');
391 $out->end_section;
392 } # generate_rdf_section
393
394 1;

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24  
Google Analytics is used in this page; Cookies are used. 忍者AdMax is used in this page; Cookies are used. Privacy policy.