/[suikacvs]/markup/html/whatpm/Whatpm/NanoDOM.pm
Suika

Contents of /markup/html/whatpm/Whatpm/NanoDOM.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.5 - (hide annotations) (download)
Sat May 19 06:02:36 2007 UTC (17 years, 5 months ago) by wakaba
Branch: MAIN
Changes since 1.4: +19 -4 lines
++ whatpm/t/ChangeLog	19 May 2007 06:02:30 -0000
	* content-model-2.dat: Tests for global attributes, |html|, |head|,
	|base|, |meta|, and |style|.

	* ContentChecker.t: Support for |#data html| (HTML parsing
	mode).

2007-05-19  Wakaba  <wakaba@suika.fam.cx>

++ whatpm/Whatpm/ChangeLog	19 May 2007 06:01:57 -0000
	* ContentChecker.pm: Attribute checkers
	for global attributes, |html|, |base|, |style|, and |meta|.

	* NanoDOM.pm (insert_before): Weaken reference
	to the parent node.
	(Attr::new): Set |owner_element| attribute.
	(namespace_uri, manakai_local_name): New attribute implementations.
	(owner_element): New attribute.

2007-05-19  Wakaba  <wakaba@suika.fam.cx>

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    
18 wakaba 1.3 require Scalar::Util;
19    
20     package Whatpm::NanoDOM::DOMImplementation;
21    
22     sub create_document ($) {
23     return Whatpm::NanoDOM::Document->new;
24     } # create_document
25    
26 wakaba 1.2 package Whatpm::NanoDOM::Node;
27 wakaba 1.1
28     sub new ($) {
29     my $class = shift;
30     my $self = bless {}, $class;
31     return $self;
32     } # new
33    
34     sub is_equal_node ($$) {
35     return shift eq shift;
36     } # is_equal_node
37    
38     sub parent_node ($) {
39     return shift->{parent_node};
40     } # parent_node
41    
42 wakaba 1.4 sub manakai_parent_element ($) {
43     my $self = shift;
44     my $parent = $self->{parent_node};
45     while (defined $parent) {
46     if ($parent->node_type == 1) {
47     return $parent;
48     } else {
49     $parent = $parent->{parent_node};
50     }
51     }
52     return undef;
53     } # manakai_parent_element
54    
55 wakaba 1.1 ## NOTE: Only applied to Elements and Documents
56     sub child_nodes ($) {
57     return shift->{child_nodes};
58     } # child_nodes
59    
60     ## NOTE: Only applied to Elements and Documents
61     sub append_child ($$) {
62     my ($self, $new_child) = @_;
63     if (defined $new_child->{parent_node}) {
64     my $parent_list = $new_child->{parent_node}->{child_nodes};
65     for (0..$#$parent_list) {
66     if ($parent_list->[$_] eq $new_child) {
67     splice @$parent_list, $_, 1;
68     }
69     }
70     }
71     push @{$self->{child_nodes}}, $new_child;
72 wakaba 1.3 $new_child->{parent_node} = $self;
73     Scalar::Util::weaken ($new_child->{parent_node});
74 wakaba 1.1 return $new_child;
75     } # append_child
76    
77     ## NOTE: Only applied to Elements and Documents
78     sub insert_before ($$;$) {
79     my ($self, $new_child, $ref_child) = @_;
80     if (defined $new_child->{parent_node}) {
81     my $parent_list = $new_child->{parent_node}->{child_nodes};
82     for (0..$#$parent_list) {
83     if ($parent_list->[$_] eq $new_child) {
84     splice @$parent_list, $_, 1;
85     }
86     }
87     }
88     my $i = @{$self->{child_nodes}};
89     if (defined $ref_child) {
90     for (0..$#{$self->{child_nodes}}) {
91     if ($self->{child_nodes}->[$_] eq $ref_child) {
92     $i = $_;
93     last;
94     }
95     }
96     }
97     splice @{$self->{child_nodes}}, $i, 0, $new_child;
98 wakaba 1.5 $new_child->{parent_node} = $self;
99     Scalar::Util::weaken ($new_child->{parent_node});
100 wakaba 1.1 return $new_child;
101     } # insert_before
102    
103     ## NOTE: Only applied to Elements and Documents
104     sub remove_child ($$) {
105     my ($self, $old_child) = @_;
106     my $parent_list = $self->{child_nodes};
107     for (0..$#$parent_list) {
108     if ($parent_list->[$_] eq $old_child) {
109     splice @$parent_list, $_, 1;
110     }
111     }
112     delete $old_child->{parent_node};
113     return $old_child;
114     } # remove_child
115    
116     ## NOTE: Only applied to Elements and Documents
117     sub has_child_nodes ($) {
118     return @{shift->{child_nodes}} > 0;
119     } # has_child_nodes
120    
121     ## NOTE: Only applied to Elements and Documents
122     sub last_child ($) {
123     my $self = shift;
124     return @{$self->{child_nodes}} ? $self->{child_nodes}->[-1] : undef;
125     } # last_child
126    
127     ## NOTE: Only applied to Elements and Documents
128     sub previous_sibling ($) {
129     my $self = shift;
130     my $parent = $self->{parent_node};
131     return undef unless defined $parent;
132     my $r;
133     for (@{$parent->{child_nodes}}) {
134     if ($_ eq $self) {
135     return $r;
136     } else {
137     $r = $_;
138     }
139     }
140     return undef;
141     } # previous_sibling
142    
143     sub ELEMENT_NODE () { 1 }
144     sub ATTRIBUTE_NODE () { 2 }
145     sub TEXT_NODE () { 3 }
146     sub CDATA_SECTION_NODE () { 4 }
147     sub ENTITY_REFERENCE_NODE () { 5 }
148     sub ENTITY_NODE () { 6 }
149     sub PROCESSING_INSTRUCTION_NODE () { 7 }
150     sub COMMENT_NODE () { 8 }
151     sub DOCUMENT_NODE () { 9 }
152     sub DOCUMENT_TYPE_NODE () { 10 }
153     sub DOCUMENT_FRAGMENT_NODE () { 11 }
154     sub NOTATION_NODE () { 12 }
155    
156 wakaba 1.2 package Whatpm::NanoDOM::Document;
157     push our @ISA, 'Whatpm::NanoDOM::Node';
158 wakaba 1.1
159     sub new ($) {
160     my $self = shift->SUPER::new;
161     $self->{child_nodes} = [];
162     return $self;
163     } # new
164    
165     ## A manakai extension
166     sub manakai_append_text ($$) {
167     my $self = shift;
168     if (@{$self->{child_nodes}} and
169     $self->{child_nodes}->[-1]->node_type == 3) {
170     $self->{child_nodes}->[-1]->manakai_append_text (shift);
171     } else {
172     my $text = $self->create_text_node (shift);
173     $self->append_child ($text);
174     }
175     } # manakai_append_text
176    
177     sub node_type () { 9 }
178    
179     sub strict_error_checking {
180     return 0;
181     } # strict_error_checking
182    
183     sub create_text_node ($$) {
184     shift;
185 wakaba 1.2 return Whatpm::NanoDOM::Text->new (shift);
186 wakaba 1.1 } # create_text_node
187    
188     sub create_comment ($$) {
189     shift;
190 wakaba 1.2 return Whatpm::NanoDOM::Comment->new (shift);
191 wakaba 1.1 } # create_comment
192    
193     ## The second parameter only supports manakai extended way
194     ## to specify qualified name - "[$prefix, $local_name]"
195     sub create_element_ns ($$$) {
196     my ($self, $nsuri, $qn) = @_;
197 wakaba 1.3 return Whatpm::NanoDOM::Element->new ($self, $nsuri, $qn->[0], $qn->[1]);
198 wakaba 1.1 } # create_element_ns
199    
200     ## A manakai extension
201     sub create_document_type_definition ($$) {
202     shift;
203 wakaba 1.2 return Whatpm::NanoDOM::DocumentType->new (shift);
204 wakaba 1.1 } # create_document_type_definition
205    
206 wakaba 1.3 sub implementation ($) {
207     return 'Whatpm::NanoDOM::DOMImplementation';
208     } # implementation
209    
210 wakaba 1.4 sub document_element ($) {
211     my $self = shift;
212     for (@{$self->child_nodes}) {
213     if ($_->node_type == 1) {
214     return $_;
215     }
216     }
217     return undef;
218     } # document_element
219    
220 wakaba 1.2 package Whatpm::NanoDOM::Element;
221     push our @ISA, 'Whatpm::NanoDOM::Node';
222 wakaba 1.1
223 wakaba 1.3 sub new ($$$$$) {
224 wakaba 1.1 my $self = shift->SUPER::new;
225 wakaba 1.3 $self->{owner_document} = shift;
226     Scalar::Util::weaken ($self->{owner_document});
227 wakaba 1.1 $self->{namespace_uri} = shift;
228     $self->{prefix} = shift;
229     $self->{local_name} = shift;
230     $self->{attributes} = {};
231     $self->{child_nodes} = [];
232     return $self;
233     } # new
234    
235 wakaba 1.3 sub owner_document ($) {
236     return shift->{owner_document};
237     } # owner_document
238    
239 wakaba 1.1 sub clone_node ($$) {
240     my ($self, $deep) = @_; ## NOTE: Deep cloning is not supported
241     my $clone = bless {
242     namespace_uri => $self->{namespace_uri},
243     prefix => $self->{prefix},
244     local_name => $self->{local_name},
245     child_nodes => [],
246     }, ref $self;
247     for my $ns (keys %{$self->{attributes}}) {
248     for my $ln (keys %{$self->{attributes}->{$ns}}) {
249     my $attr = $self->{attributes}->{$ns}->{$ln};
250     $clone->{attributes}->{$ns}->{$ln} = bless {
251     namespace_uri => $attr->{namespace_uri},
252     prefix => $attr->{prefix},
253     local_name => $attr->{local_name},
254     value => $attr->{value},
255     }, ref $self->{attributes}->{$ns}->{$ln};
256     }
257     }
258     return $clone;
259     } # clone
260    
261     ## A manakai extension
262     sub manakai_append_text ($$) {
263     my $self = shift;
264     if (@{$self->{child_nodes}} and
265     $self->{child_nodes}->[-1]->node_type == 3) {
266     $self->{child_nodes}->[-1]->manakai_append_text (shift);
267     } else {
268 wakaba 1.2 my $text = Whatpm::NanoDOM::Text->new (shift);
269 wakaba 1.1 $self->append_child ($text);
270     }
271     } # manakai_append_text
272    
273     sub attributes ($) {
274     my $self = shift;
275     my $r = [];
276     ## Order MUST be stable
277     for my $ns (sort {$a cmp $b} keys %{$self->{attributes}}) {
278     for my $ln (sort {$a cmp $b} keys %{$self->{attributes}->{$ns}}) {
279     push @$r, $self->{attributes}->{$ns}->{$ln}
280     if defined $self->{attributes}->{$ns}->{$ln};
281     }
282     }
283     return $r;
284     } # attributes
285    
286 wakaba 1.3 sub local_name ($) { # TODO: HTML5 case
287     return shift->{local_name};
288     } # local_name
289    
290 wakaba 1.4 sub manakai_local_name ($) {
291     return shift->{local_name}; # no case fixing for HTML5
292     } # manakai_local_name
293    
294 wakaba 1.3 sub namespace_uri ($) {
295     return shift->{namespace_uri};
296     } # namespace_uri
297    
298 wakaba 1.4 sub manakai_element_type_match ($$$) {
299     my ($self, $nsuri, $ln) = @_;
300     if (defined $nsuri) {
301     if (defined $self->{namespace_uri} and $nsuri eq $self->{namespace_uri}) {
302     return ($ln eq $self->{local_name});
303     } else {
304     return 0;
305     }
306     } else {
307     if (not defined $self->{namespace_uri}) {
308     return ($ln eq $self->{local_name});
309     } else {
310     return 0;
311     }
312     }
313     } # manakai_element_type_match
314    
315 wakaba 1.1 sub node_type { 1 }
316    
317     ## TODO: HTML5 capitalization
318     sub tag_name ($) {
319     my $self = shift;
320     if (defined $self->{prefix}) {
321     return $self->{prefix} . ':' . $self->{local_name};
322     } else {
323     return $self->{local_name};
324     }
325     } # tag_name
326    
327     sub has_attribute_ns ($$$) {
328     my ($self, $nsuri, $ln) = @_;
329     return defined $self->{attributes}->{$nsuri}->{$ln};
330     } # has_attribute_ns
331    
332     ## The second parameter only supports manakai extended way
333     ## to specify qualified name - "[$prefix, $local_name]"
334     sub set_attribute_ns ($$$$) {
335     my ($self, $nsuri, $qn, $value) = @_;
336     $self->{attributes}->{$nsuri}->{$qn->[1]}
337 wakaba 1.5 = Whatpm::NanoDOM::Attr->new ($self, $nsuri, $qn->[0], $qn->[1], $value);
338 wakaba 1.1 } # set_attribute_ns
339    
340 wakaba 1.2 package Whatpm::NanoDOM::Attr;
341     push our @ISA, 'Whatpm::NanoDOM::Node';
342 wakaba 1.1
343 wakaba 1.5 sub new ($$$$$$) {
344 wakaba 1.1 my $self = shift->SUPER::new;
345 wakaba 1.5 $self->{owner_element} = shift;
346     Scalar::Util::weaken ($self->{owner_element});
347 wakaba 1.1 $self->{namespace_uri} = shift;
348     $self->{prefix} = shift;
349     $self->{local_name} = shift;
350     $self->{value} = shift;
351     return $self;
352     } # new
353    
354 wakaba 1.5 sub namespace_uri ($) {
355     return shift->{namespace_uri};
356     } # namespace_uri
357    
358     sub manakai_local_name ($) {
359     return shift->{local_name};
360     } # manakai_local_name
361    
362 wakaba 1.1 sub node_type { 2 }
363    
364     ## TODO: HTML5 case stuff?
365     sub name ($) {
366     my $self = shift;
367     if (defined $self->{prefix}) {
368     return $self->{prefix} . ':' . $self->{local_name};
369     } else {
370     return $self->{local_name};
371     }
372     } # name
373    
374     sub value ($) {
375     return shift->{value};
376     } # value
377    
378 wakaba 1.5 sub owner_element ($) {
379     return shift->{owner_element};
380     } # owner_element
381    
382 wakaba 1.2 package Whatpm::NanoDOM::CharacterData;
383     push our @ISA, 'Whatpm::NanoDOM::Node';
384 wakaba 1.1
385     sub new ($$) {
386     my $self = shift->SUPER::new;
387     $self->{data} = shift;
388     return $self;
389     } # new
390    
391     ## A manakai extension
392     sub manakai_append_text ($$) {
393     my ($self, $s) = @_;
394     $self->{data} .= $s;
395     } # manakai_append_text
396    
397     sub data ($) {
398     return shift->{data};
399     } # data
400    
401 wakaba 1.2 package Whatpm::NanoDOM::Text;
402     push our @ISA, 'Whatpm::NanoDOM::CharacterData';
403 wakaba 1.1
404     sub node_type () { 3 }
405    
406 wakaba 1.2 package Whatpm::NanoDOM::Comment;
407     push our @ISA, 'Whatpm::NanoDOM::CharacterData';
408 wakaba 1.1
409     sub node_type () { 8 }
410    
411 wakaba 1.2 package Whatpm::NanoDOM::DocumentType;
412     push our @ISA, 'Whatpm::NanoDOM::Node';
413 wakaba 1.1
414     sub new ($$) {
415     my $self = shift->SUPER::new;
416     $self->{name} = shift;
417     return $self;
418     } # new
419    
420     sub node_type () { 10 }
421    
422     sub name ($) {
423     return shift->{name};
424     } # name
425    
426     =head1 SEE ALSO
427    
428 wakaba 1.2 L<Whatpm::HTML>
429 wakaba 1.1
430     =head1 AUTHOR
431    
432     Wakaba <w@suika.fam.cx>.
433    
434     =head1 LICENSE
435    
436     Copyright 2007 Wakaba <w@suika.fam.cx>
437    
438     This library is free software; you can redistribute it
439     and/or modify it under the same terms as Perl itself.
440    
441     =cut
442    
443     1;
444 wakaba 1.5 # $Date: 2007/05/04 09:16:04 $

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24