/[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.30 - (hide annotations) (download)
Sat Dec 6 10:00:53 2008 UTC (15 years, 11 months ago) by wakaba
Branch: MAIN
CVS Tags: HEAD
Changes since 1.29: +7 -2 lines
++ whatpm/t/ChangeLog	6 Dec 2008 10:00:34 -0000
2008-12-06  Wakaba  <wakaba@suika.fam.cx>

	* content-checker.pl: Use new XML parser for parsing test data.
	Use NanoDOM instead of manakai DOM implementation.

++ whatpm/Whatpm/ChangeLog	6 Dec 2008 09:58:56 -0000
2008-12-06  Wakaba  <wakaba@suika.fam.cx>

	* NanoDOM.pm (document_uri): New attribute.

	* ContentChecker.pm: Don't use methods not implemented by NanoDOM.

++ whatpm/Whatpm/ContentChecker/ChangeLog	6 Dec 2008 09:59:53 -0000
2008-12-06  Wakaba  <wakaba@suika.fam.cx>

	* HTML.pm: Use |Message::URL| for relative URL resolution.  Don't
	use attributes not supported by NanoDOM.

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 $

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24