/[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.4 - (hide annotations) (download)
Mon Jul 21 09:15:55 2008 UTC (16 years, 11 months ago) by wakaba
Branch: MAIN
Changes since 1.3: +93 -61 lines
++ ChangeLog	21 Jul 2008 09:13:35 -0000
	* cc.cgi: Old commented out code for additional
	information sections are removed.  They are now
	implemented as part of |generate_add_info_sections| method.

2008-07-21  Wakaba  <wakaba@suika.fam.cx>

++ html/WebHACC/Language/ChangeLog	21 Jul 2008 09:15:45 -0000
	* DOM.pm (generate_additional_sections): Support
	for the other additional information sections are reintroduced.
	(generate_listing_section, generate_rdf_section): Reimplemented.

	* XML.pm: Typo fixed.

	* HTML.pm: Load DOMImplementation as late as possible, to
	save possiblity that another DOM implementation can be used
	where possible.

2008-07-21  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     $out->text ('Document');
86     $out->start_tag ('ul', class => 'attributes');
87     my $cp = $child->manakai_charset;
88     if (defined $cp) {
89     $out->html (qq[<li><code>charset</code> parameter = <code>]);
90     $out->text ($cp);
91     $out->html ('</code>');
92     }
93     $out->html (qq[<li><code>inputEncoding</code> = ]);
94     my $ie = $child->input_encoding;
95     if (defined $ie) {
96     $out->code ($ie);
97     if ($child->manakai_has_bom) {
98     $out->html (qq[ (with <code class=charname><abbr>BOM</abbr></code>)]);
99     }
100     } else {
101     $out->html (qq[(<code>null</code>)]);
102     }
103     $out->html (qq[<li>@{[scalar main::get_text ('manakaiIsHTML:'.($child->manakai_is_html?1:0))]}</li>]);
104     $out->html (qq[<li>@{[scalar main::get_text ('manakaiCompatMode:'.$child->manakai_compat_mode)]}</li>]);
105     unless ($child->manakai_is_html) {
106     $out->html (qq[<li>XML version = ]);
107     $out->code ($child->xml_version);
108     if (defined $child->xml_encoding) {
109     $out->html (qq[<li>XML encoding = ]);
110     $out->code ($child->xml_encoding);
111     } else {
112     $out->html (qq[<li>XML encoding = (null)</li>]);
113     }
114     $out->html (qq[<li>XML standalone = @{[$child->xml_standalone ? 'true' : 'false']}</li>]);
115     }
116     $out->end_tag ('ul');
117     if ($child->has_child_nodes) {
118     $out->start_tag ('ol', class => 'children');
119     unshift @node, @{$child->child_nodes}, '</ol></li>';
120     }
121     } elsif ($nt == $child->DOCUMENT_TYPE_NODE) {
122     $out->start_tag ('li', id => $node_id, class => 'tree-doctype');
123     $out->code ('<!DOCTYPE>');
124     $out->start_tag ('ul', class => 'attributes');
125    
126     $out->start_tag ('li', class => 'tree-doctype-name');
127     $out->text ('Name = ');
128     $out->code ($child->name);
129    
130     $out->start_tag ('li', class => 'tree-doctype-publicid');
131     $out->text ('Public identifier = ');
132     $out->code ($child->public_id);
133    
134     $out->start_tag ('li', class => 'tree-doctype-systemid');
135     $out->text ('System identifier = ');
136     $out->code ($child->system_id);
137    
138     $out->end_tag ('ul');
139     } elsif ($nt == $child->PROCESSING_INSTRUCTION_NODE) {
140     $out->start_tag ('li', id => $node_id, class => 'tree-id');
141     $out->code ('<?');
142     $out->code ($child->target);
143     $out->text (' ');
144     $out->code ($child->data);
145     $out->code ('?>');
146     } else { # error
147     $out->start_tag ('li', id => $node_id, class => 'tree-unknown');
148     $out->text ($child->node_type . ' ' . $child->node_name);
149     }
150     }
151     $out->end_tag ('ol');
152    
153     $out->end_section;
154     } # generate_structure_dump_section
155    
156     sub generate_structure_error_section ($) {
157     my $self = shift;
158    
159     my $out = $self->output;
160 wakaba 1.3 $out->start_section (role => 'structure-errors');
161     $out->start_error_list (role => 'structure-errors');
162 wakaba 1.1
163     my $input = $self->input;
164     my $result = $self->result;
165    
166     require Whatpm::ContentChecker;
167     my $onerror = sub {
168 wakaba 1.2 $result->add_error (@_, layer => 'structure');
169 wakaba 1.1 };
170    
171     my $onsubdoc = $self->onsubdoc;
172     if ($self->{structure}->node_type == $self->{structure}->ELEMENT_NODE) {
173     $self->{add_info} = Whatpm::ContentChecker->check_element
174     ($self->{structure}, $onerror, $onsubdoc);
175     } else {
176     $self->{add_info} = Whatpm::ContentChecker->check_document
177     ($self->{structure}, $onerror, $onsubdoc);
178     }
179    
180 wakaba 1.3 $out->end_error_list (role => 'structure-errors');
181 wakaba 1.1 $out->end_section;
182     } # generate_structure_error_section
183 wakaba 1.3
184     sub generate_additional_sections ($) {
185     my $self = shift;
186     $self->SUPER::generate_additional_sections;
187 wakaba 1.4
188 wakaba 1.3 $self->generate_table_section;
189 wakaba 1.4
190     $self->generate_listing_section (
191     key => 'id', id => 'identifiers',
192     short_title => 'IDs', title => 'Identifiers',
193     );
194     $self->generate_listing_section (
195     key => 'term', id => 'terms',
196     short_title => 'Terms', title => 'Terms',
197     );
198     $self->generate_listing_section (
199     key => 'class', id => 'classes',
200     short_title => 'Classes', title => 'Classes',
201     );
202    
203     $self->generate_rdf_section;
204 wakaba 1.3 } # generate_additional_sections
205    
206     sub generate_table_section ($) {
207     my $self = shift;
208    
209     my $tables = $self->{add_info}->{table} || [];
210     return unless @$tables;
211    
212     my $out = $self->output;
213     $out->start_section (id => 'tables', title => 'Tables');
214    
215     $out->html (q[<!--[if IE]><script type="text/javascript" src="../excanvas.js"></script><![endif]-->
216     <script src="../table-script.js" type="text/javascript"></script>
217     <noscript>
218     <p><em>Structure of tables are visualized here if scripting is enabled.</em></p>
219     </noscript>]);
220    
221     require JSON;
222    
223     my $i = 0;
224     for my $table (@$tables) {
225     $i++;
226     $out->start_section (id => 'table-' . $i,
227     title => 'Table #' . $i);
228    
229     $out->start_tag ('dl');
230     $out->dt ('Table Element');
231     $out->start_tag ('dd');
232     $out->node_link ($table->{element});
233     $out->end_tag ('dl');
234     delete $table->{element};
235    
236     for (@{$table->{column_group}}, @{$table->{column}}, $table->{caption},
237     @{$table->{row}}) {
238     next unless $_;
239     delete $_->{element};
240     }
241    
242     for (@{$table->{row_group}}) {
243     next unless $_;
244     next unless $_->{element};
245     $_->{type} = $_->{element}->manakai_local_name;
246     delete $_->{element};
247     }
248    
249     for (@{$table->{cell}}) {
250     next unless $_;
251     for (@{$_}) {
252     next unless $_;
253     for (@$_) {
254     $_->{id} = refaddr $_->{element} if defined $_->{element};
255     delete $_->{element};
256     $_->{is_header} = $_->{is_header} ? 1 : 0;
257     }
258     }
259     }
260    
261     my $id_prefix = $self->input->id_prefix;
262     $out->script (q[tableToCanvas (] .
263     JSON::objToJson ($table) .
264     q[, document.getElementById ('] . $id_prefix . 'table-' . $i . q[')] .
265     q[, '] . $id_prefix . q[');]);
266    
267     $out->end_section;
268     }
269    
270     $out->end_section;
271 wakaba 1.4 } # generate_table_section
272 wakaba 1.3
273 wakaba 1.4 sub generate_listing_section ($%) {
274     my $self = shift;
275     my %opt = @_;
276 wakaba 1.3
277 wakaba 1.4 my $list = $self->{add_info}->{$opt{key}} || {};
278     return unless keys %$list;
279 wakaba 1.3
280 wakaba 1.4 my $out = $self->output;
281 wakaba 1.3
282 wakaba 1.4 $out->start_section (id => $opt{id},
283     title => $opt{title},
284     short_title => $opt{short_title});
285     $out->start_tag ('dl');
286    
287     for my $id (sort {$a cmp $b} keys %$list) {
288     $out->start_tag ('dt');
289     $out->code ($id);
290     for (@{$list->{$id}}) {
291     $out->start_tag ('dd');
292     $out->node_link ($_);
293 wakaba 1.3 }
294     }
295    
296 wakaba 1.4 $out->end_tag ('dl');
297     $out->end_section;
298     } # generate_listing_section
299    
300     my $generate_rdf_resource_html = sub ($$) {
301     my ($resource, $out) = @_;
302    
303 wakaba 1.3 if (defined $resource->{uri}) {
304 wakaba 1.4 $out->url ($resource->{uri});
305 wakaba 1.3 } elsif (defined $resource->{bnodeid}) {
306 wakaba 1.4 $out->text ('_:' . $resource->{bnodeid});
307 wakaba 1.3 } elsif ($resource->{nodes}) {
308 wakaba 1.4 $out->text ('(rdf:XMLLiteral)');
309 wakaba 1.3 } elsif (defined $resource->{value}) {
310 wakaba 1.4 $out->start_tag ('q',
311     lang => defined $resource->{language}
312     ? $resource->{language} : '');
313     $out->text ($resource->{value});
314     $out->end_tag ('q');
315    
316 wakaba 1.3 if (defined $resource->{datatype}) {
317 wakaba 1.4 $out->text ('^^');
318     $out->url ($resource->{datatype});
319 wakaba 1.3 } elsif (length $resource->{language}) {
320 wakaba 1.4 $out->text ('@' . $resource->{language});
321 wakaba 1.3 }
322     } else {
323 wakaba 1.4 $out->text ('??'); ## NOTE: An error of the implementation.
324 wakaba 1.3 }
325 wakaba 1.4 }; # $generate_rdf_resource_html
326    
327     ## TODO: Should we move this method to another module,
328     ## such as Base or RDF?
329     sub generate_rdf_section ($) {
330     my $self = shift;
331    
332     my $list = $self->{add_info}->{rdf} || [];
333     return unless @$list;
334    
335     my $out = $self->output;
336     $out->start_section (id => 'rdf', short_title => 'RDF',
337     title => 'RDF Triples');
338     $out->start_tag ('dl');
339    
340     my $i = 0;
341     for my $rdf (@$list) {
342     $out->start_tag ('dt', id => 'rdf-' . $i++);
343     $out->node_link ($rdf->[0]);
344     $out->start_tag ('dd');
345     $out->start_tag ('dl');
346     for my $triple (@{$rdf->[1]}) {
347     $out->start_tag ('dt');
348     $out->node_link ($triple->[0]);
349     $out->start_tag ('dd');
350     $out->text ('Subject: ');
351     $generate_rdf_resource_html->($triple->[1] => $out);
352     $out->start_tag ('dd');
353     $out->text ('Predicate: ');
354     $generate_rdf_resource_html->($triple->[2] => $out);
355     $out->start_tag ('dd');
356     $out->text ('Object: ');
357     $generate_rdf_resource_html->($triple->[3] => $out);
358     }
359     $out->end_tag ('dl');
360     }
361     $out->end_tag ('dl');
362     $out->end_section;
363     } # generate_rdf_section
364 wakaba 1.1
365     1;

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24