/[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.9 - (hide annotations) (download)
Fri Aug 15 14:11:13 2008 UTC (16 years, 10 months ago) by wakaba
Branch: MAIN
Changes since 1.8: +6 -3 lines
++ ChangeLog	15 Aug 2008 14:09:57 -0000
	* error-description-source.xml: Error entries
	for Whatpm::RDFXML errors are addded.  Missing entries
	for Whatpm::HTMLTable errors are added.

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

++ html/WebHACC/Language/ChangeLog	15 Aug 2008 14:11:09 -0000
	* DOM.pm: Enable localization of RDF section.

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

++ html/WebHACC/ChangeLog	15 Aug 2008 14:10:46 -0000
	* Output.pm (xref_text): New method.
	(node_link): Don't make node path consumed by catalog
	engine.

2008-08-15  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.8 $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 wakaba 1.9 $out->nl_text ('Subject');
380     $out->text (': ');
381 wakaba 1.4 $generate_rdf_resource_html->($triple->[1] => $out);
382     $out->start_tag ('dd');
383 wakaba 1.9 $out->nl_text ('Predicate');
384     $out->text (': ');
385 wakaba 1.4 $generate_rdf_resource_html->($triple->[2] => $out);
386     $out->start_tag ('dd');
387 wakaba 1.9 $out->nl_text ('Object');
388     $out->text (': ');
389 wakaba 1.4 $generate_rdf_resource_html->($triple->[3] => $out);
390     }
391     $out->end_tag ('dl');
392     }
393     $out->end_tag ('dl');
394     $out->end_section;
395     } # generate_rdf_section
396 wakaba 1.1
397     1;

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24