/[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.2 - (show annotations) (download)
Sun Jul 20 16:53:10 2008 UTC (16 years, 11 months ago) by wakaba
Branch: MAIN
Changes since 1.1: +1 -11 lines 
++ ChangeLog	20 Jul 2008 16:48:51 -0000
2008-07-21  Wakaba  <wakaba@suika.fam.cx>

	* cc.cgi: Errors and results are now handled by WebHACC::Result.
	Decode |uri| parameter as UTF-8.  HTTP header dump and
	input error are now handled by WebHACC::Input.

++ html/WebHACC/Language/ChangeLog	20 Jul 2008 16:53:06 -0000
2008-07-21  Wakaba  <wakaba@suika.fam.cx>

	* Base.pm (_get_cc_url, _encode_url_component): Remove (now
	supported by WebHACC::Output).

	* CSS.pm, CacheManifest.pm, DOM.pm, Default.pm,
	HTML.pm, WebIDL.pm, XML.pm: Error reporting is now delegated to
	WebHACC::Result.

++ html/WebHACC/ChangeLog	20 Jul 2008 16:50:41 -0000
2008-07-21  Wakaba  <wakaba@suika.fam.cx>

	* Input.pm (generate_transfer_sections, generate_http_header_section):
	New (partially comes from cc.cgi).

	* Output.pm (link): Call |start_tag| such that attributes
	can be set.
	(link_to_webhacc): New.
	(encode_url_component): From WebHACC::Language::Base.

	* Result.pm: Support for error outputting and result table
	generation.
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 (id => 'document-tree', title => 'Document Tree',
14 short_title => 'Tree');
15
16 $out->start_tag ('ol', class => 'xoxo');
17
18 my @node = ($self->{structure});
19 while (@node) {
20 my $child = shift @node;
21 unless (ref $child) {
22 $out->html ($child);
23 next;
24 }
25
26 my $node_id = 'node-'.refaddr $child;
27 my $nt = $child->node_type;
28 if ($nt == $child->ELEMENT_NODE) {
29 my $child_nsuri = $child->namespace_uri;
30 $out->start_tag ('li', id => $node_id, class => 'tree-element');
31 $out->start_tag ('code',
32 title => defined $child_nsuri ? $child_nsuri : '');
33 $out->text ($child->tag_name); ## TODO: case
34 $out->end_tag ('code');
35
36 if ($child->has_attributes) {
37 $out->start_tag ('ul', class => 'attributes');
38 for my $attr (sort {$a->[0] cmp $b->[0]} map { [$_->name, $_->value, $_->namespace_uri, 'node-'.refaddr $_] }
39 @{$child->attributes}) {
40 $out->start_tag ('li', id => $attr->[3], class => 'tree-attribute');
41 $out->start_tag ('code',
42 title => defined $attr->[2] ? $attr->[2] : '');
43 $out->html ($attr->[0]); ## ISSUE: case
44 $out->end_tag ('code');
45 $out->text (' = ');
46 $out->start_tag ('q');
47 $out->text ($attr->[1]); ## TODO: children
48 $out->end_tag ('q');
49 }
50 $out->end_tag ('ul');
51 }
52
53 if ($child->has_child_nodes) {
54 $out->start_tag ('ol', class => 'children');
55 unshift @node, @{$child->child_nodes}, '</ol></li>';
56 }
57 } elsif ($nt == $child->TEXT_NODE) {
58 $out->start_tag ('li', id => $node_id, class => 'tree-text');
59 $out->start_tag ('q', lang => '');
60 $out->text ($child->data);
61 $out->end_tag ('q');
62 } elsif ($nt == $child->CDATA_SECTION_NODE) {
63 $out->start_tag ('li', id => $node_id, class => 'tree-cdata');
64 $out->start_tag ('code');
65 $out->text ('<![CDATA[');
66 $out->end_tag ('code');
67 $out->start_tag ('q', lang => '');
68 $out->text ($child->data);
69 $out->end_tag ('q');
70 $out->start_tag ('code');
71 $out->text (']]>');
72 $out->end_tag ('code');
73 } elsif ($nt == $child->COMMENT_NODE) {
74 $out->start_tag ('li', id => $node_id, class => 'tree-cdata');
75 $out->start_tag ('code');
76 $out->text ('<!--');
77 $out->end_tag ('code');
78 $out->start_tag ('q', lang => '');
79 $out->text ($child->data);
80 $out->end_tag ('q');
81 $out->start_tag ('code');
82 $out->text ('-->');
83 $out->end_tag ('code');
84 } elsif ($nt == $child->DOCUMENT_NODE) {
85 $out->start_tag ('li', id => $node_id, class => 'tree-document');
86 $out->text ('Document');
87 $out->start_tag ('ul', class => 'attributes');
88 my $cp = $child->manakai_charset;
89 if (defined $cp) {
90 $out->html (qq[<li><code>charset</code> parameter = <code>]);
91 $out->text ($cp);
92 $out->html ('</code>');
93 }
94 $out->html (qq[<li><code>inputEncoding</code> = ]);
95 my $ie = $child->input_encoding;
96 if (defined $ie) {
97 $out->code ($ie);
98 if ($child->manakai_has_bom) {
99 $out->html (qq[ (with <code class=charname><abbr>BOM</abbr></code>)]);
100 }
101 } else {
102 $out->html (qq[(<code>null</code>)]);
103 }
104 $out->html (qq[<li>@{[scalar main::get_text ('manakaiIsHTML:'.($child->manakai_is_html?1:0))]}</li>]);
105 $out->html (qq[<li>@{[scalar main::get_text ('manakaiCompatMode:'.$child->manakai_compat_mode)]}</li>]);
106 unless ($child->manakai_is_html) {
107 $out->html (qq[<li>XML version = ]);
108 $out->code ($child->xml_version);
109 if (defined $child->xml_encoding) {
110 $out->html (qq[<li>XML encoding = ]);
111 $out->code ($child->xml_encoding);
112 } else {
113 $out->html (qq[<li>XML encoding = (null)</li>]);
114 }
115 $out->html (qq[<li>XML standalone = @{[$child->xml_standalone ? 'true' : 'false']}</li>]);
116 }
117 $out->end_tag ('ul');
118 if ($child->has_child_nodes) {
119 $out->start_tag ('ol', class => 'children');
120 unshift @node, @{$child->child_nodes}, '</ol></li>';
121 }
122 } elsif ($nt == $child->DOCUMENT_TYPE_NODE) {
123 $out->start_tag ('li', id => $node_id, class => 'tree-doctype');
124 $out->code ('<!DOCTYPE>');
125 $out->start_tag ('ul', class => 'attributes');
126
127 $out->start_tag ('li', class => 'tree-doctype-name');
128 $out->text ('Name = ');
129 $out->code ($child->name);
130
131 $out->start_tag ('li', class => 'tree-doctype-publicid');
132 $out->text ('Public identifier = ');
133 $out->code ($child->public_id);
134
135 $out->start_tag ('li', class => 'tree-doctype-systemid');
136 $out->text ('System identifier = ');
137 $out->code ($child->system_id);
138
139 $out->end_tag ('ul');
140 } elsif ($nt == $child->PROCESSING_INSTRUCTION_NODE) {
141 $out->start_tag ('li', id => $node_id, class => 'tree-id');
142 $out->code ('<?');
143 $out->code ($child->target);
144 $out->text (' ');
145 $out->code ($child->data);
146 $out->code ('?>');
147 } else { # error
148 $out->start_tag ('li', id => $node_id, class => 'tree-unknown');
149 $out->text ($child->node_type . ' ' . $child->node_name);
150 }
151 }
152 $out->end_tag ('ol');
153
154 $out->end_section;
155 } # generate_structure_dump_section
156
157 sub generate_structure_error_section ($) {
158 my $self = shift;
159
160 my $out = $self->output;
161 $out->start_section (id => 'document-errors', title => 'Document Errors');
162 $out->start_tag ('dl', class => 'document-errors-list');
163
164 my $input = $self->input;
165 my $result = $self->result;
166
167 require Whatpm::ContentChecker;
168 my $onerror = sub {
169 $result->add_error (@_, layer => 'structure');
170 };
171
172 my $onsubdoc = $self->onsubdoc;
173 if ($self->{structure}->node_type == $self->{structure}->ELEMENT_NODE) {
174 $self->{add_info} = Whatpm::ContentChecker->check_element
175 ($self->{structure}, $onerror, $onsubdoc);
176 } else {
177 $self->{add_info} = Whatpm::ContentChecker->check_document
178 ($self->{structure}, $onerror, $onsubdoc);
179 }
180
181 $out->end_tag ('dl');
182 $out->html (qq[<script>
183 addSourceToParseErrorList ('@{[$input->id_prefix]}', 'document-errors-list');
184 </script>]);
185 $out->end_section;
186 } # generate_structure_error_section
187
188 1;
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24