/[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.8 - (show annotations) (download)
Fri Aug 15 12:11:56 2008 UTC (16 years, 10 months ago) by wakaba
Branch: MAIN
Changes since 1.7: +1 -1 lines
++ ChangeLog	15 Aug 2008 12:10:51 -0000
	* error-description-source.xml: Missing entries for
	Whatpm::ContentChecker and Whatpm::ContentChecker::HTML
	error types are added.  Error entries used by these
	modules are marked as such.

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

++ html/WebHACC/Language/ChangeLog	15 Aug 2008 12:11:51 -0000
	* DOM.pm: Use error's own "layer" parameter, if any.

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

++ html/WebHACC/ChangeLog	15 Aug 2008 12:11:25 -0000
	* Output.pm (nl_text): New rule, <var>{value}</var>,
	is implemented.

2008-08-15  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