/[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 - (hide annotations) (download)
Thu Aug 14 15:50:42 2008 UTC (16 years, 10 months 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 wakaba 1.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 wakaba 1.3 $out->start_section (role => 'tree');
14 wakaba 1.1
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 wakaba 1.6 $out->nl_text ('Document');
86    
87 wakaba 1.1 $out->start_tag ('ul', class => 'attributes');
88 wakaba 1.6
89 wakaba 1.1 my $cp = $child->manakai_charset;
90     if (defined $cp) {
91 wakaba 1.6 $out->start_tag ('li');
92     $out->nl_text ('manakaiCharset');
93     $out->text (' = ');
94     $out->code ($cp);
95 wakaba 1.1 }
96 wakaba 1.6
97     $out->start_tag ('li');
98     $out->nl_text ('inputEncoding');
99     $out->text (' = ');
100 wakaba 1.1 my $ie = $child->input_encoding;
101     if (defined $ie) {
102     $out->code ($ie);
103     if ($child->manakai_has_bom) {
104 wakaba 1.6 $out->nl_text ('... with BOM');
105 wakaba 1.1 }
106     } else {
107     $out->html (qq[(<code>null</code>)]);
108     }
109 wakaba 1.6
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 wakaba 1.1 unless ($child->manakai_is_html) {
117 wakaba 1.6 $out->start_tag ('li');
118     $out->nl_text ('xmlVersion');
119     $out->text (' = ');
120 wakaba 1.1 $out->code ($child->xml_version);
121 wakaba 1.6
122     $out->start_tag ('li');
123     $out->nl_text ('xmlEncoding');
124     $out->text (' = ');
125 wakaba 1.1 if (defined $child->xml_encoding) {
126     $out->code ($child->xml_encoding);
127     } else {
128 wakaba 1.6 $out->html ('(<code>null</code>)');
129 wakaba 1.1 }
130 wakaba 1.6
131     $out->start_tag ('li');
132     $out->nl_text ('xmlStandalone');
133     $out->text (' = ');
134     $out->code ($child->xml_standalone ? 'true' : 'false');
135 wakaba 1.1 }
136 wakaba 1.6
137 wakaba 1.1 $out->end_tag ('ul');
138 wakaba 1.6
139 wakaba 1.1 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 wakaba 1.3 $out->start_section (role => 'structure-errors');
183     $out->start_error_list (role => 'structure-errors');
184 wakaba 1.7 $self->result->layer_applicable ('structure');
185 wakaba 1.1
186     my $input = $self->input;
187     my $result = $self->result;
188    
189     require Whatpm::ContentChecker;
190     my $onerror = sub {
191 wakaba 1.2 $result->add_error (@_, layer => 'structure');
192 wakaba 1.1 };
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 wakaba 1.3 $out->end_error_list (role => 'structure-errors');
204 wakaba 1.1 $out->end_section;
205 wakaba 1.7
206     $self->result->layer_uncertain ('semantics');
207 wakaba 1.1 } # generate_structure_error_section
208 wakaba 1.3
209     sub generate_additional_sections ($) {
210     my $self = shift;
211     $self->SUPER::generate_additional_sections;
212 wakaba 1.4
213 wakaba 1.3 $self->generate_table_section;
214 wakaba 1.4
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 wakaba 1.3 } # 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 wakaba 1.6 $out->start_section (id => 'tables', short_title => 'Tables',
239     title => 'Tables Section');
240 wakaba 1.3
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 wakaba 1.5 my $index = $out->input->full_subdocument_index;
253     $index = $index ? $index . '.' . $i : $i;
254 wakaba 1.3 $out->start_section (id => 'table-' . $i,
255 wakaba 1.6 title => 'Table #',
256     text => $index);
257 wakaba 1.3
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 wakaba 1.4 } # generate_table_section
301 wakaba 1.3
302 wakaba 1.4 sub generate_listing_section ($%) {
303     my $self = shift;
304     my %opt = @_;
305 wakaba 1.3
306 wakaba 1.4 my $list = $self->{add_info}->{$opt{key}} || {};
307     return unless keys %$list;
308 wakaba 1.3
309 wakaba 1.4 my $out = $self->output;
310 wakaba 1.3
311 wakaba 1.4 $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 wakaba 1.3 }
323     }
324    
325 wakaba 1.4 $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 wakaba 1.3 if (defined $resource->{uri}) {
333 wakaba 1.4 $out->url ($resource->{uri});
334 wakaba 1.3 } elsif (defined $resource->{bnodeid}) {
335 wakaba 1.4 $out->text ('_:' . $resource->{bnodeid});
336 wakaba 1.3 } elsif ($resource->{nodes}) {
337 wakaba 1.4 $out->text ('(rdf:XMLLiteral)');
338 wakaba 1.3 } elsif (defined $resource->{value}) {
339 wakaba 1.4 $out->start_tag ('q',
340     lang => defined $resource->{language}
341     ? $resource->{language} : '');
342     $out->text ($resource->{value});
343     $out->end_tag ('q');
344    
345 wakaba 1.3 if (defined $resource->{datatype}) {
346 wakaba 1.4 $out->text ('^^');
347     $out->url ($resource->{datatype});
348 wakaba 1.3 } elsif (length $resource->{language}) {
349 wakaba 1.4 $out->text ('@' . $resource->{language});
350 wakaba 1.3 }
351     } else {
352 wakaba 1.4 $out->text ('??'); ## NOTE: An error of the implementation.
353 wakaba 1.3 }
354 wakaba 1.4 }; # $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 wakaba 1.1
394     1;

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24