/[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.4 - (hide annotations) (download)
Fri May 4 09:16:04 2007 UTC (17 years, 6 months ago) by wakaba
Branch: MAIN
Changes since 1.3: +45 -1 lines
++ whatpm/t/ChangeLog	4 May 2007 09:15:43 -0000
2007-05-03  Wakaba  <wakaba@suika.fam.cx>

	* tokenizer-test-1.test: Incorrect DOCTYPE testa
	are added.

	* tree-test-1.dat: |innerHTML| tests are added.

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

	* LICENSE: New document.

++ whatpm/Whatpm/ChangeLog	4 May 2007 09:13:06 -0000
2007-05-04  Wakaba  <wakaba@suika.fam.cx>

	* NanoDOM.pm (manakai_parent_element,
	document_element, manakai_local_name,
	manakai_element_type_match): New method.

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

	* HTML.pm.src: Replace decimal and hexadecimal numeric
	entities in C1 range using Windows-1252 mapping.  Bare LF
	did not count as new line for error reporting.

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

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24