1 |
wakaba |
1.1 |
=head1 NAME |
2 |
|
|
|
3 |
wakaba |
1.2 |
Whatpm::NanoDOM - A Non-Conforming Implementation of DOM Subset |
4 |
wakaba |
1.1 |
|
5 |
|
|
=head1 DESCRIPTION |
6 |
|
|
|
7 |
wakaba |
1.2 |
The C<Whatpm::NanoDOM> module contains a non-conforming implementation |
8 |
wakaba |
1.1 |
of a subset of DOM. It is the intention that this module is |
9 |
wakaba |
1.2 |
used only for the purpose of testing the C<Whatpm::HTML> module. |
10 |
wakaba |
1.1 |
|
11 |
|
|
See source code if you would like to know what it does. |
12 |
|
|
|
13 |
|
|
=cut |
14 |
|
|
|
15 |
wakaba |
1.2 |
package Whatpm::NanoDOM; |
16 |
wakaba |
1.1 |
use strict; |
17 |
wakaba |
1.30 |
our $VERSION=do{my @r=(q$Revision: 1.29 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r}; |
18 |
wakaba |
1.1 |
|
19 |
wakaba |
1.3 |
require Scalar::Util; |
20 |
|
|
|
21 |
|
|
package Whatpm::NanoDOM::DOMImplementation; |
22 |
|
|
|
23 |
|
|
sub create_document ($) { |
24 |
|
|
return Whatpm::NanoDOM::Document->new; |
25 |
|
|
} # create_document |
26 |
|
|
|
27 |
wakaba |
1.2 |
package Whatpm::NanoDOM::Node; |
28 |
wakaba |
1.1 |
|
29 |
|
|
sub new ($) { |
30 |
|
|
my $class = shift; |
31 |
|
|
my $self = bless {}, $class; |
32 |
|
|
return $self; |
33 |
|
|
} # new |
34 |
|
|
|
35 |
|
|
sub parent_node ($) { |
36 |
|
|
return shift->{parent_node}; |
37 |
|
|
} # parent_node |
38 |
|
|
|
39 |
wakaba |
1.4 |
sub manakai_parent_element ($) { |
40 |
|
|
my $self = shift; |
41 |
|
|
my $parent = $self->{parent_node}; |
42 |
|
|
while (defined $parent) { |
43 |
|
|
if ($parent->node_type == 1) { |
44 |
|
|
return $parent; |
45 |
|
|
} else { |
46 |
|
|
$parent = $parent->{parent_node}; |
47 |
|
|
} |
48 |
|
|
} |
49 |
|
|
return undef; |
50 |
|
|
} # manakai_parent_element |
51 |
|
|
|
52 |
wakaba |
1.1 |
sub child_nodes ($) { |
53 |
wakaba |
1.7 |
return shift->{child_nodes} || []; |
54 |
wakaba |
1.1 |
} # child_nodes |
55 |
|
|
|
56 |
wakaba |
1.23 |
sub node_name ($) { return $_[0]->{node_name} } |
57 |
|
|
|
58 |
wakaba |
1.1 |
## NOTE: Only applied to Elements and Documents |
59 |
|
|
sub append_child ($$) { |
60 |
|
|
my ($self, $new_child) = @_; |
61 |
|
|
if (defined $new_child->{parent_node}) { |
62 |
|
|
my $parent_list = $new_child->{parent_node}->{child_nodes}; |
63 |
|
|
for (0..$#$parent_list) { |
64 |
|
|
if ($parent_list->[$_] eq $new_child) { |
65 |
|
|
splice @$parent_list, $_, 1; |
66 |
|
|
} |
67 |
|
|
} |
68 |
|
|
} |
69 |
|
|
push @{$self->{child_nodes}}, $new_child; |
70 |
wakaba |
1.3 |
$new_child->{parent_node} = $self; |
71 |
|
|
Scalar::Util::weaken ($new_child->{parent_node}); |
72 |
wakaba |
1.1 |
return $new_child; |
73 |
|
|
} # append_child |
74 |
|
|
|
75 |
|
|
## NOTE: Only applied to Elements and Documents |
76 |
|
|
sub insert_before ($$;$) { |
77 |
|
|
my ($self, $new_child, $ref_child) = @_; |
78 |
|
|
if (defined $new_child->{parent_node}) { |
79 |
|
|
my $parent_list = $new_child->{parent_node}->{child_nodes}; |
80 |
|
|
for (0..$#$parent_list) { |
81 |
|
|
if ($parent_list->[$_] eq $new_child) { |
82 |
|
|
splice @$parent_list, $_, 1; |
83 |
|
|
} |
84 |
|
|
} |
85 |
|
|
} |
86 |
|
|
my $i = @{$self->{child_nodes}}; |
87 |
|
|
if (defined $ref_child) { |
88 |
|
|
for (0..$#{$self->{child_nodes}}) { |
89 |
|
|
if ($self->{child_nodes}->[$_] eq $ref_child) { |
90 |
|
|
$i = $_; |
91 |
|
|
last; |
92 |
|
|
} |
93 |
|
|
} |
94 |
|
|
} |
95 |
|
|
splice @{$self->{child_nodes}}, $i, 0, $new_child; |
96 |
wakaba |
1.5 |
$new_child->{parent_node} = $self; |
97 |
|
|
Scalar::Util::weaken ($new_child->{parent_node}); |
98 |
wakaba |
1.1 |
return $new_child; |
99 |
|
|
} # insert_before |
100 |
|
|
|
101 |
|
|
## NOTE: Only applied to Elements and Documents |
102 |
|
|
sub remove_child ($$) { |
103 |
|
|
my ($self, $old_child) = @_; |
104 |
|
|
my $parent_list = $self->{child_nodes}; |
105 |
|
|
for (0..$#$parent_list) { |
106 |
|
|
if ($parent_list->[$_] eq $old_child) { |
107 |
|
|
splice @$parent_list, $_, 1; |
108 |
|
|
} |
109 |
|
|
} |
110 |
|
|
delete $old_child->{parent_node}; |
111 |
|
|
return $old_child; |
112 |
|
|
} # remove_child |
113 |
|
|
|
114 |
|
|
## NOTE: Only applied to Elements and Documents |
115 |
|
|
sub has_child_nodes ($) { |
116 |
|
|
return @{shift->{child_nodes}} > 0; |
117 |
|
|
} # has_child_nodes |
118 |
|
|
|
119 |
|
|
## NOTE: Only applied to Elements and Documents |
120 |
wakaba |
1.8 |
sub first_child ($) { |
121 |
|
|
my $self = shift; |
122 |
|
|
return $self->{child_nodes}->[0]; |
123 |
|
|
} # first_child |
124 |
|
|
|
125 |
|
|
## NOTE: Only applied to Elements and Documents |
126 |
wakaba |
1.1 |
sub last_child ($) { |
127 |
|
|
my $self = shift; |
128 |
|
|
return @{$self->{child_nodes}} ? $self->{child_nodes}->[-1] : undef; |
129 |
|
|
} # last_child |
130 |
|
|
|
131 |
|
|
## NOTE: Only applied to Elements and Documents |
132 |
|
|
sub previous_sibling ($) { |
133 |
|
|
my $self = shift; |
134 |
|
|
my $parent = $self->{parent_node}; |
135 |
|
|
return undef unless defined $parent; |
136 |
|
|
my $r; |
137 |
|
|
for (@{$parent->{child_nodes}}) { |
138 |
|
|
if ($_ eq $self) { |
139 |
|
|
return $r; |
140 |
|
|
} else { |
141 |
|
|
$r = $_; |
142 |
|
|
} |
143 |
|
|
} |
144 |
|
|
return undef; |
145 |
|
|
} # previous_sibling |
146 |
|
|
|
147 |
wakaba |
1.6 |
sub prefix ($;$) { |
148 |
|
|
my $self = shift; |
149 |
|
|
if (@_) { |
150 |
|
|
$self->{prefix} = shift; |
151 |
|
|
} |
152 |
|
|
return $self->{prefix}; |
153 |
|
|
} # prefix |
154 |
|
|
|
155 |
wakaba |
1.24 |
sub text_content ($;$) { |
156 |
|
|
my $self = shift; |
157 |
|
|
if (@_) { |
158 |
|
|
@{$self->{child_nodes}} = (); ## NOTE: parent_node not unset. |
159 |
wakaba |
1.29 |
$self->append_child (Whatpm::NanoDOM::Text->new ($_[0])) if length $_[0]; |
160 |
wakaba |
1.24 |
return unless wantarray; |
161 |
|
|
} |
162 |
|
|
my $r = ''; |
163 |
|
|
for my $child (@{$self->child_nodes}) { |
164 |
|
|
if ($child->can ('data')) { |
165 |
|
|
$r .= $child->data; |
166 |
|
|
} else { |
167 |
|
|
$r .= $child->text_content; |
168 |
|
|
} |
169 |
|
|
} |
170 |
|
|
return $r; |
171 |
|
|
} # text_content |
172 |
|
|
|
173 |
wakaba |
1.18 |
sub get_user_data ($$) { |
174 |
|
|
return $_[0]->{$_[1]}; |
175 |
|
|
} # get_user_data |
176 |
|
|
|
177 |
|
|
sub set_user_data ($$;$$) { |
178 |
|
|
$_[0]->{$_[1]} = $_[2]; |
179 |
|
|
} # set_user_data |
180 |
|
|
|
181 |
wakaba |
1.1 |
sub ELEMENT_NODE () { 1 } |
182 |
|
|
sub ATTRIBUTE_NODE () { 2 } |
183 |
|
|
sub TEXT_NODE () { 3 } |
184 |
|
|
sub CDATA_SECTION_NODE () { 4 } |
185 |
|
|
sub ENTITY_REFERENCE_NODE () { 5 } |
186 |
|
|
sub ENTITY_NODE () { 6 } |
187 |
|
|
sub PROCESSING_INSTRUCTION_NODE () { 7 } |
188 |
|
|
sub COMMENT_NODE () { 8 } |
189 |
|
|
sub DOCUMENT_NODE () { 9 } |
190 |
|
|
sub DOCUMENT_TYPE_NODE () { 10 } |
191 |
|
|
sub DOCUMENT_FRAGMENT_NODE () { 11 } |
192 |
|
|
sub NOTATION_NODE () { 12 } |
193 |
wakaba |
1.23 |
sub ELEMENT_TYPE_DEFINITION_NODE () { 81001 } |
194 |
|
|
sub ATTRIBUTE_DEFINITION_NODE () { 81002 } |
195 |
wakaba |
1.1 |
|
196 |
wakaba |
1.2 |
package Whatpm::NanoDOM::Document; |
197 |
|
|
push our @ISA, 'Whatpm::NanoDOM::Node'; |
198 |
wakaba |
1.1 |
|
199 |
|
|
sub new ($) { |
200 |
|
|
my $self = shift->SUPER::new; |
201 |
|
|
$self->{child_nodes} = []; |
202 |
|
|
return $self; |
203 |
|
|
} # new |
204 |
|
|
|
205 |
|
|
## A manakai extension |
206 |
|
|
sub manakai_append_text ($$) { |
207 |
|
|
my $self = shift; |
208 |
|
|
if (@{$self->{child_nodes}} and |
209 |
|
|
$self->{child_nodes}->[-1]->node_type == 3) { |
210 |
|
|
$self->{child_nodes}->[-1]->manakai_append_text (shift); |
211 |
|
|
} else { |
212 |
|
|
my $text = $self->create_text_node (shift); |
213 |
|
|
$self->append_child ($text); |
214 |
|
|
} |
215 |
|
|
} # manakai_append_text |
216 |
|
|
|
217 |
|
|
sub node_type () { 9 } |
218 |
|
|
|
219 |
|
|
sub strict_error_checking { |
220 |
|
|
return 0; |
221 |
|
|
} # strict_error_checking |
222 |
|
|
|
223 |
|
|
sub create_text_node ($$) { |
224 |
|
|
shift; |
225 |
wakaba |
1.2 |
return Whatpm::NanoDOM::Text->new (shift); |
226 |
wakaba |
1.1 |
} # create_text_node |
227 |
|
|
|
228 |
|
|
sub create_comment ($$) { |
229 |
|
|
shift; |
230 |
wakaba |
1.2 |
return Whatpm::NanoDOM::Comment->new (shift); |
231 |
wakaba |
1.1 |
} # create_comment |
232 |
|
|
|
233 |
|
|
## The second parameter only supports manakai extended way |
234 |
|
|
## to specify qualified name - "[$prefix, $local_name]" |
235 |
wakaba |
1.20 |
sub create_attribute_ns ($$$) { |
236 |
|
|
my ($self, $nsuri, $qn) = @_; |
237 |
|
|
return Whatpm::NanoDOM::Attr->new (undef, $nsuri, $qn->[0], $qn->[1], ''); |
238 |
|
|
|
239 |
|
|
## NOTE: Created attribute node should be set to an element node |
240 |
|
|
## as far as possible. |onwer_document| of the attribute node, for |
241 |
|
|
## example, depends on the definedness of the |owner_element| attribute. |
242 |
|
|
} # create_attribute_ns |
243 |
|
|
|
244 |
|
|
## The second parameter only supports manakai extended way |
245 |
|
|
## to specify qualified name - "[$prefix, $local_name]" |
246 |
wakaba |
1.1 |
sub create_element_ns ($$$) { |
247 |
|
|
my ($self, $nsuri, $qn) = @_; |
248 |
wakaba |
1.3 |
return Whatpm::NanoDOM::Element->new ($self, $nsuri, $qn->[0], $qn->[1]); |
249 |
wakaba |
1.1 |
} # create_element_ns |
250 |
|
|
|
251 |
|
|
## A manakai extension |
252 |
|
|
sub create_document_type_definition ($$) { |
253 |
|
|
shift; |
254 |
wakaba |
1.2 |
return Whatpm::NanoDOM::DocumentType->new (shift); |
255 |
wakaba |
1.1 |
} # create_document_type_definition |
256 |
|
|
|
257 |
wakaba |
1.23 |
## A manakai extension. |
258 |
|
|
sub create_element_type_definition ($$) { |
259 |
|
|
shift; |
260 |
|
|
return Whatpm::NanoDOM::ElementTypeDefinition->new (shift); |
261 |
|
|
} # create_element_type_definition |
262 |
|
|
|
263 |
|
|
## A manakai extension. |
264 |
|
|
sub create_general_entity ($$) { |
265 |
|
|
shift; |
266 |
|
|
return Whatpm::NanoDOM::Entity->new (shift); |
267 |
|
|
} # create_general_entity |
268 |
|
|
|
269 |
|
|
## A manakai extension. |
270 |
|
|
sub create_notation ($$) { |
271 |
|
|
shift; |
272 |
|
|
return Whatpm::NanoDOM::Notation->new (shift); |
273 |
|
|
} # create_notation |
274 |
|
|
|
275 |
|
|
## A manakai extension. |
276 |
|
|
sub create_attribute_definition ($$) { |
277 |
|
|
shift; |
278 |
|
|
return Whatpm::NanoDOM::AttributeDefinition->new (shift); |
279 |
|
|
} # create_attribute_definition |
280 |
|
|
|
281 |
wakaba |
1.22 |
sub create_processing_instruction ($$$) { |
282 |
|
|
return Whatpm::NanoDOM::ProcessingInstruction->new (@_); |
283 |
|
|
} # creat_processing_instruction |
284 |
|
|
|
285 |
wakaba |
1.3 |
sub implementation ($) { |
286 |
|
|
return 'Whatpm::NanoDOM::DOMImplementation'; |
287 |
|
|
} # implementation |
288 |
|
|
|
289 |
wakaba |
1.4 |
sub document_element ($) { |
290 |
|
|
my $self = shift; |
291 |
|
|
for (@{$self->child_nodes}) { |
292 |
|
|
if ($_->node_type == 1) { |
293 |
|
|
return $_; |
294 |
|
|
} |
295 |
|
|
} |
296 |
|
|
return undef; |
297 |
|
|
} # document_element |
298 |
|
|
|
299 |
wakaba |
1.21 |
sub dom_config ($) { |
300 |
|
|
return {}; |
301 |
|
|
} # dom_config |
302 |
|
|
|
303 |
wakaba |
1.12 |
sub adopt_node ($$) { |
304 |
wakaba |
1.11 |
my @node = ($_[1]); |
305 |
|
|
while (@node) { |
306 |
|
|
my $node = shift @node; |
307 |
|
|
$node->{owner_document} = $_[0]; |
308 |
|
|
Scalar::Util::weaken ($node->{owner_document}); |
309 |
|
|
push @node, @{$node->child_nodes}; |
310 |
|
|
push @node, @{$node->attributes or []} if $node->can ('attributes'); |
311 |
|
|
} |
312 |
|
|
return $_[1]; |
313 |
|
|
} # adopt_node |
314 |
|
|
|
315 |
wakaba |
1.12 |
sub manakai_is_html ($;$) { |
316 |
|
|
if (@_ > 1) { |
317 |
|
|
if ($_[1]) { |
318 |
|
|
$_[0]->{manakai_is_html} = 1; |
319 |
|
|
} else { |
320 |
wakaba |
1.13 |
delete $_[0]->{manakai_is_html}; |
321 |
wakaba |
1.12 |
delete $_[0]->{manakai_compat_mode}; |
322 |
|
|
} |
323 |
|
|
} |
324 |
|
|
return $_[0]->{manakai_is_html}; |
325 |
|
|
} # manakai_is_html |
326 |
|
|
|
327 |
|
|
sub compat_mode ($) { |
328 |
|
|
if ($_[0]->{manakai_is_html}) { |
329 |
|
|
if ($_[0]->{manakai_compat_mode} eq 'quirks') { |
330 |
|
|
return 'BackCompat'; |
331 |
|
|
} |
332 |
|
|
} |
333 |
|
|
return 'CSS1Compat'; |
334 |
|
|
} # compat_mode |
335 |
|
|
|
336 |
|
|
sub manakai_compat_mode ($;$) { |
337 |
|
|
if ($_[0]->{manakai_is_html}) { |
338 |
|
|
if (@_ > 1 and defined $_[1] and |
339 |
|
|
{'no quirks' => 1, 'limited quirks' => 1, 'quirks' => 1}->{$_[1]}) { |
340 |
|
|
$_[0]->{manakai_compat_mode} = $_[1]; |
341 |
|
|
} |
342 |
|
|
return $_[0]->{manakai_compat_mode} || 'no quirks'; |
343 |
|
|
} else { |
344 |
|
|
return 'no quirks'; |
345 |
|
|
} |
346 |
|
|
} # manakai_compat_mode |
347 |
|
|
|
348 |
wakaba |
1.19 |
sub manakai_head ($) { |
349 |
|
|
my $html = $_[0]->manakai_html; |
350 |
|
|
return undef unless defined $html; |
351 |
|
|
for my $el (@{$html->child_nodes}) { |
352 |
|
|
next unless $el->node_type == 1; # ELEMENT_NODE |
353 |
|
|
my $nsuri = $el->namespace_uri; |
354 |
|
|
next unless defined $nsuri; |
355 |
|
|
next unless $nsuri eq q<http://www.w3.org/1999/xhtml>; |
356 |
|
|
next unless $el->manakai_local_name eq 'head'; |
357 |
|
|
return $el; |
358 |
|
|
} |
359 |
|
|
return undef; |
360 |
|
|
} # manakai_head |
361 |
|
|
|
362 |
|
|
sub manakai_html ($) { |
363 |
|
|
my $de = $_[0]->document_element; |
364 |
|
|
my $nsuri = $de->namespace_uri; |
365 |
|
|
if (defined $nsuri and $nsuri eq q<http://www.w3.org/1999/xhtml> and |
366 |
|
|
$de->manakai_local_name eq 'html') { |
367 |
|
|
return $de; |
368 |
|
|
} else { |
369 |
|
|
return undef; |
370 |
|
|
} |
371 |
|
|
} # manakai_html |
372 |
|
|
|
373 |
wakaba |
1.28 |
## NOTE: Manakai extension. |
374 |
|
|
sub all_declarations_processed ($;$) { |
375 |
|
|
$_[0]->{all_declarations_processed} = $_[1] if @_ > 1; |
376 |
|
|
return $_[0]->{all_declarations_processed}; |
377 |
|
|
} # all_declarations_processed |
378 |
|
|
|
379 |
wakaba |
1.17 |
sub input_encoding ($;$) { |
380 |
|
|
$_[0]->{input_encoding} = $_[1] if @_ > 1; |
381 |
|
|
return $_[0]->{input_encoding}; |
382 |
|
|
} |
383 |
|
|
|
384 |
|
|
sub manakai_charset ($;$) { |
385 |
|
|
$_[0]->{manakai_charset} = $_[1] if @_ > 1; |
386 |
|
|
return $_[0]->{manakai_charset}; |
387 |
|
|
} |
388 |
|
|
|
389 |
|
|
sub manakai_has_bom ($;$) { |
390 |
|
|
$_[0]->{manakai_has_bom} = $_[1] if @_ > 1; |
391 |
|
|
return $_[0]->{manakai_has_bom}; |
392 |
|
|
} |
393 |
|
|
|
394 |
wakaba |
1.22 |
sub xml_version ($;$) { |
395 |
|
|
$_[0]->{xml_version} = $_[1] if @_ > 1; |
396 |
|
|
return $_[0]->{xml_version}; |
397 |
|
|
} |
398 |
|
|
|
399 |
|
|
sub xml_encoding ($;$) { |
400 |
|
|
$_[0]->{xml_encoding} = $_[1] if @_ > 1; |
401 |
|
|
return $_[0]->{xml_encoding}; |
402 |
|
|
} |
403 |
|
|
|
404 |
|
|
sub xml_standalone ($;$) { |
405 |
|
|
$_[0]->{xml_standalone} = $_[1] if @_ > 1; |
406 |
|
|
return $_[0]->{xml_standalone}; |
407 |
|
|
} |
408 |
|
|
|
409 |
wakaba |
1.30 |
sub document_uri ($;$) { |
410 |
|
|
$_[0]->{document_uri} = $_[1] if @_ > 1; |
411 |
|
|
return $_[0]->{document_uri}; |
412 |
|
|
} |
413 |
|
|
|
414 |
wakaba |
1.2 |
package Whatpm::NanoDOM::Element; |
415 |
|
|
push our @ISA, 'Whatpm::NanoDOM::Node'; |
416 |
wakaba |
1.1 |
|
417 |
wakaba |
1.3 |
sub new ($$$$$) { |
418 |
wakaba |
1.1 |
my $self = shift->SUPER::new; |
419 |
wakaba |
1.3 |
$self->{owner_document} = shift; |
420 |
|
|
Scalar::Util::weaken ($self->{owner_document}); |
421 |
wakaba |
1.1 |
$self->{namespace_uri} = shift; |
422 |
|
|
$self->{prefix} = shift; |
423 |
|
|
$self->{local_name} = shift; |
424 |
|
|
$self->{attributes} = {}; |
425 |
|
|
$self->{child_nodes} = []; |
426 |
|
|
return $self; |
427 |
|
|
} # new |
428 |
|
|
|
429 |
wakaba |
1.3 |
sub owner_document ($) { |
430 |
|
|
return shift->{owner_document}; |
431 |
|
|
} # owner_document |
432 |
|
|
|
433 |
wakaba |
1.1 |
sub clone_node ($$) { |
434 |
|
|
my ($self, $deep) = @_; ## NOTE: Deep cloning is not supported |
435 |
|
|
my $clone = bless { |
436 |
|
|
namespace_uri => $self->{namespace_uri}, |
437 |
|
|
prefix => $self->{prefix}, |
438 |
|
|
local_name => $self->{local_name}, |
439 |
|
|
child_nodes => [], |
440 |
|
|
}, ref $self; |
441 |
|
|
for my $ns (keys %{$self->{attributes}}) { |
442 |
|
|
for my $ln (keys %{$self->{attributes}->{$ns}}) { |
443 |
|
|
my $attr = $self->{attributes}->{$ns}->{$ln}; |
444 |
|
|
$clone->{attributes}->{$ns}->{$ln} = bless { |
445 |
|
|
namespace_uri => $attr->{namespace_uri}, |
446 |
|
|
prefix => $attr->{prefix}, |
447 |
|
|
local_name => $attr->{local_name}, |
448 |
|
|
value => $attr->{value}, |
449 |
|
|
}, ref $self->{attributes}->{$ns}->{$ln}; |
450 |
|
|
} |
451 |
|
|
} |
452 |
|
|
return $clone; |
453 |
|
|
} # clone |
454 |
|
|
|
455 |
|
|
## A manakai extension |
456 |
|
|
sub manakai_append_text ($$) { |
457 |
|
|
my $self = shift; |
458 |
|
|
if (@{$self->{child_nodes}} and |
459 |
|
|
$self->{child_nodes}->[-1]->node_type == 3) { |
460 |
|
|
$self->{child_nodes}->[-1]->manakai_append_text (shift); |
461 |
|
|
} else { |
462 |
wakaba |
1.2 |
my $text = Whatpm::NanoDOM::Text->new (shift); |
463 |
wakaba |
1.1 |
$self->append_child ($text); |
464 |
|
|
} |
465 |
|
|
} # manakai_append_text |
466 |
|
|
|
467 |
|
|
sub attributes ($) { |
468 |
|
|
my $self = shift; |
469 |
|
|
my $r = []; |
470 |
|
|
## Order MUST be stable |
471 |
|
|
for my $ns (sort {$a cmp $b} keys %{$self->{attributes}}) { |
472 |
|
|
for my $ln (sort {$a cmp $b} keys %{$self->{attributes}->{$ns}}) { |
473 |
|
|
push @$r, $self->{attributes}->{$ns}->{$ln} |
474 |
|
|
if defined $self->{attributes}->{$ns}->{$ln}; |
475 |
|
|
} |
476 |
|
|
} |
477 |
|
|
return $r; |
478 |
|
|
} # attributes |
479 |
|
|
|
480 |
wakaba |
1.3 |
sub local_name ($) { # TODO: HTML5 case |
481 |
|
|
return shift->{local_name}; |
482 |
|
|
} # local_name |
483 |
|
|
|
484 |
wakaba |
1.4 |
sub manakai_local_name ($) { |
485 |
|
|
return shift->{local_name}; # no case fixing for HTML5 |
486 |
|
|
} # manakai_local_name |
487 |
|
|
|
488 |
wakaba |
1.3 |
sub namespace_uri ($) { |
489 |
|
|
return shift->{namespace_uri}; |
490 |
|
|
} # namespace_uri |
491 |
|
|
|
492 |
wakaba |
1.4 |
sub manakai_element_type_match ($$$) { |
493 |
|
|
my ($self, $nsuri, $ln) = @_; |
494 |
|
|
if (defined $nsuri) { |
495 |
|
|
if (defined $self->{namespace_uri} and $nsuri eq $self->{namespace_uri}) { |
496 |
|
|
return ($ln eq $self->{local_name}); |
497 |
|
|
} else { |
498 |
|
|
return 0; |
499 |
|
|
} |
500 |
|
|
} else { |
501 |
|
|
if (not defined $self->{namespace_uri}) { |
502 |
|
|
return ($ln eq $self->{local_name}); |
503 |
|
|
} else { |
504 |
|
|
return 0; |
505 |
|
|
} |
506 |
|
|
} |
507 |
|
|
} # manakai_element_type_match |
508 |
|
|
|
509 |
wakaba |
1.1 |
sub node_type { 1 } |
510 |
|
|
|
511 |
|
|
## TODO: HTML5 capitalization |
512 |
|
|
sub tag_name ($) { |
513 |
|
|
my $self = shift; |
514 |
|
|
if (defined $self->{prefix}) { |
515 |
|
|
return $self->{prefix} . ':' . $self->{local_name}; |
516 |
|
|
} else { |
517 |
|
|
return $self->{local_name}; |
518 |
|
|
} |
519 |
|
|
} # tag_name |
520 |
|
|
|
521 |
wakaba |
1.8 |
sub get_attribute_ns ($$$) { |
522 |
|
|
my ($self, $nsuri, $ln) = @_; |
523 |
|
|
$nsuri = '' unless defined $nsuri; |
524 |
|
|
return defined $self->{attributes}->{$nsuri}->{$ln} |
525 |
|
|
? $self->{attributes}->{$nsuri}->{$ln}->value : undef; |
526 |
|
|
} # get_attribute_ns |
527 |
|
|
|
528 |
wakaba |
1.9 |
sub get_attribute_node_ns ($$$) { |
529 |
|
|
my ($self, $nsuri, $ln) = @_; |
530 |
|
|
$nsuri = '' unless defined $nsuri; |
531 |
|
|
return $self->{attributes}->{$nsuri}->{$ln}; |
532 |
|
|
} # get_attribute_node_ns |
533 |
|
|
|
534 |
wakaba |
1.1 |
sub has_attribute_ns ($$$) { |
535 |
|
|
my ($self, $nsuri, $ln) = @_; |
536 |
wakaba |
1.8 |
$nsuri = '' unless defined $nsuri; |
537 |
wakaba |
1.1 |
return defined $self->{attributes}->{$nsuri}->{$ln}; |
538 |
|
|
} # has_attribute_ns |
539 |
|
|
|
540 |
|
|
## The second parameter only supports manakai extended way |
541 |
|
|
## to specify qualified name - "[$prefix, $local_name]" |
542 |
|
|
sub set_attribute_ns ($$$$) { |
543 |
|
|
my ($self, $nsuri, $qn, $value) = @_; |
544 |
|
|
$self->{attributes}->{$nsuri}->{$qn->[1]} |
545 |
wakaba |
1.5 |
= Whatpm::NanoDOM::Attr->new ($self, $nsuri, $qn->[0], $qn->[1], $value); |
546 |
wakaba |
1.1 |
} # set_attribute_ns |
547 |
|
|
|
548 |
wakaba |
1.20 |
sub set_attribute_node_ns ($$) { |
549 |
|
|
my $self = shift; |
550 |
|
|
my $attr = shift; |
551 |
|
|
$self->{attributes}->{$attr->namespace_uri}->{$attr->manakai_local_name} |
552 |
|
|
= $attr; |
553 |
|
|
$attr->{owner_element} = $self; |
554 |
|
|
Scalar::Util::weaken ($attr->{owner_element}); |
555 |
|
|
} # set_attribute_node_ns |
556 |
|
|
|
557 |
wakaba |
1.2 |
package Whatpm::NanoDOM::Attr; |
558 |
|
|
push our @ISA, 'Whatpm::NanoDOM::Node'; |
559 |
wakaba |
1.1 |
|
560 |
wakaba |
1.5 |
sub new ($$$$$$) { |
561 |
wakaba |
1.1 |
my $self = shift->SUPER::new; |
562 |
wakaba |
1.5 |
$self->{owner_element} = shift; |
563 |
|
|
Scalar::Util::weaken ($self->{owner_element}); |
564 |
wakaba |
1.1 |
$self->{namespace_uri} = shift; |
565 |
|
|
$self->{prefix} = shift; |
566 |
|
|
$self->{local_name} = shift; |
567 |
|
|
$self->{value} = shift; |
568 |
wakaba |
1.28 |
$self->{specified} = 1; |
569 |
wakaba |
1.1 |
return $self; |
570 |
|
|
} # new |
571 |
|
|
|
572 |
wakaba |
1.5 |
sub namespace_uri ($) { |
573 |
|
|
return shift->{namespace_uri}; |
574 |
|
|
} # namespace_uri |
575 |
|
|
|
576 |
|
|
sub manakai_local_name ($) { |
577 |
|
|
return shift->{local_name}; |
578 |
|
|
} # manakai_local_name |
579 |
|
|
|
580 |
wakaba |
1.1 |
sub node_type { 2 } |
581 |
|
|
|
582 |
wakaba |
1.14 |
sub owner_document ($) { |
583 |
|
|
return shift->owner_element->owner_document; |
584 |
|
|
} # owner_document |
585 |
|
|
|
586 |
wakaba |
1.1 |
## TODO: HTML5 case stuff? |
587 |
|
|
sub name ($) { |
588 |
|
|
my $self = shift; |
589 |
|
|
if (defined $self->{prefix}) { |
590 |
|
|
return $self->{prefix} . ':' . $self->{local_name}; |
591 |
|
|
} else { |
592 |
|
|
return $self->{local_name}; |
593 |
|
|
} |
594 |
|
|
} # name |
595 |
|
|
|
596 |
wakaba |
1.20 |
sub value ($;$) { |
597 |
|
|
if (@_ > 1) { |
598 |
|
|
$_[0]->{value} = $_[1]; |
599 |
|
|
} |
600 |
wakaba |
1.1 |
return shift->{value}; |
601 |
|
|
} # value |
602 |
|
|
|
603 |
wakaba |
1.5 |
sub owner_element ($) { |
604 |
|
|
return shift->{owner_element}; |
605 |
|
|
} # owner_element |
606 |
|
|
|
607 |
wakaba |
1.28 |
sub specified ($;$) { |
608 |
|
|
$_[0]->{specified} = $_[1] if @_ > 1; |
609 |
|
|
return $_[0]->{specified} || 0; |
610 |
|
|
} |
611 |
|
|
|
612 |
|
|
sub manakai_attribute_type ($;$) { |
613 |
|
|
$_[0]->{manakai_attribute_type} = $_[1] if @_ > 1; |
614 |
|
|
return $_[0]->{manakai_attribute_type} || 0; |
615 |
|
|
} |
616 |
|
|
|
617 |
wakaba |
1.2 |
package Whatpm::NanoDOM::CharacterData; |
618 |
|
|
push our @ISA, 'Whatpm::NanoDOM::Node'; |
619 |
wakaba |
1.1 |
|
620 |
|
|
sub new ($$) { |
621 |
|
|
my $self = shift->SUPER::new; |
622 |
|
|
$self->{data} = shift; |
623 |
|
|
return $self; |
624 |
|
|
} # new |
625 |
|
|
|
626 |
|
|
## A manakai extension |
627 |
|
|
sub manakai_append_text ($$) { |
628 |
|
|
my ($self, $s) = @_; |
629 |
|
|
$self->{data} .= $s; |
630 |
|
|
} # manakai_append_text |
631 |
|
|
|
632 |
|
|
sub data ($) { |
633 |
|
|
return shift->{data}; |
634 |
|
|
} # data |
635 |
|
|
|
636 |
wakaba |
1.2 |
package Whatpm::NanoDOM::Text; |
637 |
|
|
push our @ISA, 'Whatpm::NanoDOM::CharacterData'; |
638 |
wakaba |
1.1 |
|
639 |
|
|
sub node_type () { 3 } |
640 |
|
|
|
641 |
wakaba |
1.2 |
package Whatpm::NanoDOM::Comment; |
642 |
|
|
push our @ISA, 'Whatpm::NanoDOM::CharacterData'; |
643 |
wakaba |
1.1 |
|
644 |
|
|
sub node_type () { 8 } |
645 |
|
|
|
646 |
wakaba |
1.2 |
package Whatpm::NanoDOM::DocumentType; |
647 |
|
|
push our @ISA, 'Whatpm::NanoDOM::Node'; |
648 |
wakaba |
1.1 |
|
649 |
|
|
sub new ($$) { |
650 |
|
|
my $self = shift->SUPER::new; |
651 |
|
|
$self->{name} = shift; |
652 |
wakaba |
1.23 |
$self->{element_types} = {}; |
653 |
|
|
$self->{entities} = {}; |
654 |
|
|
$self->{notations} = {}; |
655 |
|
|
$self->{child_nodes} = []; |
656 |
wakaba |
1.1 |
return $self; |
657 |
|
|
} # new |
658 |
|
|
|
659 |
|
|
sub node_type () { 10 } |
660 |
|
|
|
661 |
|
|
sub name ($) { |
662 |
|
|
return shift->{name}; |
663 |
|
|
} # name |
664 |
|
|
|
665 |
wakaba |
1.16 |
sub public_id ($;$) { |
666 |
|
|
$_[0]->{public_id} = $_[1] if @_ > 1; |
667 |
|
|
return $_[0]->{public_id}; |
668 |
|
|
} # public_id |
669 |
|
|
|
670 |
|
|
sub system_id ($;$) { |
671 |
|
|
$_[0]->{system_id} = $_[1] if @_ > 1; |
672 |
|
|
return $_[0]->{system_id}; |
673 |
|
|
} # system_id |
674 |
|
|
|
675 |
wakaba |
1.23 |
sub element_types ($) { |
676 |
|
|
return $_[0]->{element_types}; |
677 |
|
|
} # element_types |
678 |
|
|
|
679 |
|
|
sub entities ($) { |
680 |
|
|
return $_[0]->{entities}; |
681 |
|
|
} # entities |
682 |
|
|
|
683 |
|
|
sub notations ($) { |
684 |
|
|
return $_[0]->{notations}; |
685 |
|
|
} # notations |
686 |
|
|
|
687 |
|
|
sub get_element_type_definition_node ($$) { |
688 |
|
|
return $_[0]->{element_types}->{$_[1]}; |
689 |
|
|
} # get_element_type_definition_node |
690 |
|
|
|
691 |
|
|
sub set_element_type_definition_node ($$) { |
692 |
|
|
$_[0]->{element_types}->{$_[1]->node_name} = $_[1]; |
693 |
|
|
} # set_element_type_definition_node |
694 |
|
|
|
695 |
|
|
sub get_general_entity_node ($$) { |
696 |
|
|
return $_[0]->{entities}->{$_[1]}; |
697 |
|
|
} # get_general_entity_node |
698 |
|
|
|
699 |
|
|
sub set_general_entity_node ($$) { |
700 |
|
|
$_[0]->{entities}->{$_[1]->node_name} = $_[1]; |
701 |
|
|
} # set_general_entity_node |
702 |
|
|
|
703 |
|
|
sub get_notation_node ($$) { |
704 |
|
|
return $_[0]->{notations}->{$_[1]}; |
705 |
|
|
} # get_notation_node |
706 |
|
|
|
707 |
|
|
sub set_notation_node ($$) { |
708 |
|
|
$_[0]->{notations}->{$_[1]->node_name} = $_[1]; |
709 |
|
|
} # set_notation_node |
710 |
|
|
|
711 |
wakaba |
1.22 |
package Whatpm::NanoDOM::ProcessingInstruction; |
712 |
|
|
push our @ISA, 'Whatpm::NanoDOM::Node'; |
713 |
|
|
|
714 |
|
|
sub new ($$$$) { |
715 |
|
|
my $self = shift->SUPER::new; |
716 |
|
|
shift; |
717 |
|
|
# $self->{owner_document} = shift; |
718 |
|
|
# Scalar::Util::weaken ($self->{owner_document}); |
719 |
|
|
$self->{target} = shift; |
720 |
|
|
$self->{data} = shift; |
721 |
|
|
return $self; |
722 |
|
|
} # new |
723 |
|
|
|
724 |
|
|
sub node_type () { 7 } |
725 |
|
|
|
726 |
|
|
sub target ($) { |
727 |
|
|
return $_[0]->{target}; |
728 |
|
|
} # target |
729 |
|
|
|
730 |
|
|
sub data ($;$) { |
731 |
|
|
$_[0]->{data} = $_[1] if @_ > 1; |
732 |
|
|
return $_[0]->{data}; |
733 |
|
|
} # data |
734 |
|
|
|
735 |
wakaba |
1.23 |
package Whatpm::NanoDOM::Entity; |
736 |
|
|
push our @ISA, 'Whatpm::NanoDOM::Node'; |
737 |
|
|
|
738 |
|
|
sub new ($$) { |
739 |
|
|
my $self = shift->SUPER::new; |
740 |
|
|
$self->{node_name} = shift; |
741 |
wakaba |
1.27 |
$self->{child_nodes} = []; |
742 |
wakaba |
1.23 |
return $self; |
743 |
|
|
} # new |
744 |
|
|
|
745 |
|
|
sub node_type () { 6 } |
746 |
|
|
|
747 |
wakaba |
1.25 |
sub public_id ($;$) { |
748 |
|
|
$_[0]->{public_id} = $_[1] if @_ > 1; |
749 |
|
|
return $_[0]->{public_id}; |
750 |
|
|
} # public_id |
751 |
|
|
|
752 |
|
|
sub system_id ($;$) { |
753 |
|
|
$_[0]->{system_id} = $_[1] if @_ > 1; |
754 |
|
|
return $_[0]->{system_id}; |
755 |
|
|
} # system_id |
756 |
|
|
|
757 |
wakaba |
1.26 |
sub notation_name ($;$) { |
758 |
|
|
$_[0]->{notation_name} = $_[1] if @_ > 1; |
759 |
|
|
return $_[0]->{notation_name}; |
760 |
|
|
} # notation_name |
761 |
|
|
|
762 |
wakaba |
1.23 |
package Whatpm::NanoDOM::Notation; |
763 |
|
|
push our @ISA, 'Whatpm::NanoDOM::Node'; |
764 |
|
|
|
765 |
|
|
sub new ($$) { |
766 |
|
|
my $self = shift->SUPER::new; |
767 |
|
|
$self->{node_name} = shift; |
768 |
|
|
return $self; |
769 |
|
|
} # new |
770 |
|
|
|
771 |
|
|
sub node_type () { 12 } |
772 |
|
|
|
773 |
wakaba |
1.25 |
sub public_id ($;$) { |
774 |
|
|
$_[0]->{public_id} = $_[1] if @_ > 1; |
775 |
|
|
return $_[0]->{public_id}; |
776 |
|
|
} # public_id |
777 |
|
|
|
778 |
|
|
sub system_id ($;$) { |
779 |
|
|
$_[0]->{system_id} = $_[1] if @_ > 1; |
780 |
|
|
return $_[0]->{system_id}; |
781 |
|
|
} # system_id |
782 |
|
|
|
783 |
wakaba |
1.23 |
package Whatpm::NanoDOM::ElementTypeDefinition; |
784 |
|
|
push our @ISA, 'Whatpm::NanoDOM::Node'; |
785 |
|
|
|
786 |
|
|
sub new ($$) { |
787 |
|
|
my $self = shift->SUPER::new; |
788 |
|
|
$self->{node_name} = shift; |
789 |
|
|
$self->{content_model} = ''; |
790 |
|
|
$self->{attribute_definitions} = {}; |
791 |
|
|
return $self; |
792 |
|
|
} # new |
793 |
|
|
|
794 |
|
|
sub node_type () { 81001 } |
795 |
|
|
|
796 |
|
|
sub content_model_text ($;$) { |
797 |
|
|
$_[0]->{content_model} = $_[1] if @_ > 1; |
798 |
|
|
return $_[0]->{content_model}; |
799 |
|
|
} # content_model_text |
800 |
|
|
|
801 |
|
|
sub attribute_definitions ($) { return $_[0]->{attribute_definitions} } |
802 |
|
|
|
803 |
|
|
sub get_attribute_definition_node ($$) { |
804 |
|
|
return $_[0]->{attribute_definitions}->{$_[1]}; |
805 |
|
|
} # get_attribute_definition_node |
806 |
|
|
|
807 |
|
|
sub set_attribute_definition_node ($$) { |
808 |
|
|
$_[0]->{attribute_definitions}->{$_[1]->node_name} = $_[1]; |
809 |
|
|
} # set_attribute_definition_node |
810 |
|
|
|
811 |
|
|
package Whatpm::NanoDOM::AttributeDefinition; |
812 |
|
|
push our @ISA, 'Whatpm::NanoDOM::Node'; |
813 |
|
|
|
814 |
|
|
sub new ($$) { |
815 |
|
|
my $self = shift->SUPER::new; |
816 |
|
|
$self->{node_name} = shift; |
817 |
wakaba |
1.24 |
$self->{allowed_tokens} = []; |
818 |
wakaba |
1.23 |
return $self; |
819 |
|
|
} # new |
820 |
|
|
|
821 |
|
|
sub node_type () { 81002 } |
822 |
|
|
|
823 |
wakaba |
1.24 |
sub allowed_tokens ($) { return $_[0]->{allowed_tokens} } |
824 |
|
|
|
825 |
|
|
sub default_type ($;$) { |
826 |
|
|
$_[0]->{default_type} = $_[1] if @_ > 1; |
827 |
|
|
return $_[0]->{default_type} || 0; |
828 |
|
|
} # default_type |
829 |
|
|
|
830 |
|
|
sub declared_type ($;$) { |
831 |
|
|
$_[0]->{declared_type} = $_[1] if @_ > 1; |
832 |
|
|
return $_[0]->{declared_type} || 0; |
833 |
|
|
} # declared_type |
834 |
|
|
|
835 |
wakaba |
1.1 |
=head1 SEE ALSO |
836 |
|
|
|
837 |
wakaba |
1.22 |
L<Whatpm::HTML|Whatpm::HTML> |
838 |
|
|
|
839 |
|
|
L<Whatpm::XML::Parser|Whatpm::XML::Parser> |
840 |
|
|
|
841 |
|
|
L<Whatpm::ContentChecker|Whatpm::ContentChecker> |
842 |
wakaba |
1.1 |
|
843 |
|
|
=head1 AUTHOR |
844 |
|
|
|
845 |
|
|
Wakaba <w@suika.fam.cx>. |
846 |
|
|
|
847 |
|
|
=head1 LICENSE |
848 |
|
|
|
849 |
wakaba |
1.22 |
Copyright 2007-2008 Wakaba <w@suika.fam.cx> |
850 |
wakaba |
1.1 |
|
851 |
|
|
This library is free software; you can redistribute it |
852 |
|
|
and/or modify it under the same terms as Perl itself. |
853 |
|
|
|
854 |
|
|
=cut |
855 |
|
|
|
856 |
|
|
1; |
857 |
wakaba |
1.30 |
# $Date: 2008/11/07 08:45:28 $ |