/[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.7 - (hide annotations) (download)
Sat May 26 12:33:04 2007 UTC (18 years, 8 months ago) by wakaba
Branch: MAIN
Changes since 1.6: +15 -3 lines
++ whatpm/t/ChangeLog	26 May 2007 12:32:50 -0000
	* content-model-2.dat: Tests for |rel| values are added.

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

++ whatpm/Whatpm/ChangeLog	26 May 2007 12:32:20 -0000
	* ContentChecker.pm ($HTMLLinkTypesAttrChecker): New checker.
	(link/@rel, a/@rel, area/@rel): Use new checker.

	* Makefile (_LinkTypeList.pm, RelExtensions.html): New rules.

	* _LinkTypeList.pm: New file.

	* mklinktypelist.pl: New file.

	* .cvsignore: |RelExtensions.html| added.

	* NanoDOM.pm (child_nodes): Returns an empty array
	for non-child-containing node types.
	(text_content): New attribute.

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

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24