/[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 - (hide 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 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     $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 wakaba 1.2 $result->add_error (@_, layer => 'structure');
170 wakaba 1.1 };
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