/[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 - (show 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 =head1 NAME
2
3 Whatpm::NanoDOM - A Non-Conforming Implementation of DOM Subset
4
5 =head1 DESCRIPTION
6
7 The C<Whatpm::NanoDOM> module contains a non-conforming implementation
8 of a subset of DOM. It is the intention that this module is
9 used only for the purpose of testing the C<Whatpm::HTML> module.
10
11 See source code if you would like to know what it does.
12
13 =cut
14
15 package Whatpm::NanoDOM;
16 use strict;
17 our $VERSION=do{my @r=(q$Revision: 1.29 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
18
19 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 package Whatpm::NanoDOM::Node;
28
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 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 sub child_nodes ($) {
53 return shift->{child_nodes} || [];
54 } # child_nodes
55
56 sub node_name ($) { return $_[0]->{node_name} }
57
58 ## 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 $new_child->{parent_node} = $self;
71 Scalar::Util::weaken ($new_child->{parent_node});
72 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 $new_child->{parent_node} = $self;
97 Scalar::Util::weaken ($new_child->{parent_node});
98 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 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 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 sub prefix ($;$) {
148 my $self = shift;
149 if (@_) {
150 $self->{prefix} = shift;
151 }
152 return $self->{prefix};
153 } # prefix
154
155 sub text_content ($;$) {
156 my $self = shift;
157 if (@_) {
158 @{$self->{child_nodes}} = (); ## NOTE: parent_node not unset.
159 $self->append_child (Whatpm::NanoDOM::Text->new ($_[0])) if length $_[0];
160 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 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 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 sub ELEMENT_TYPE_DEFINITION_NODE () { 81001 }
194 sub ATTRIBUTE_DEFINITION_NODE () { 81002 }
195
196 package Whatpm::NanoDOM::Document;
197 push our @ISA, 'Whatpm::NanoDOM::Node';
198
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 return Whatpm::NanoDOM::Text->new (shift);
226 } # create_text_node
227
228 sub create_comment ($$) {
229 shift;
230 return Whatpm::NanoDOM::Comment->new (shift);
231 } # create_comment
232
233 ## The second parameter only supports manakai extended way
234 ## to specify qualified name - "[$prefix, $local_name]"
235 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 sub create_element_ns ($$$) {
247 my ($self, $nsuri, $qn) = @_;
248 return Whatpm::NanoDOM::Element->new ($self, $nsuri, $qn->[0], $qn->[1]);
249 } # create_element_ns
250
251 ## A manakai extension
252 sub create_document_type_definition ($$) {
253 shift;
254 return Whatpm::NanoDOM::DocumentType->new (shift);
255 } # create_document_type_definition
256
257 ## 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 sub create_processing_instruction ($$$) {
282 return Whatpm::NanoDOM::ProcessingInstruction->new (@_);
283 } # creat_processing_instruction
284
285 sub implementation ($) {
286 return 'Whatpm::NanoDOM::DOMImplementation';
287 } # implementation
288
289 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 sub dom_config ($) {
300 return {};
301 } # dom_config
302
303 sub adopt_node ($$) {
304 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 sub manakai_is_html ($;$) {
316 if (@_ > 1) {
317 if ($_[1]) {
318 $_[0]->{manakai_is_html} = 1;
319 } else {
320 delete $_[0]->{manakai_is_html};
321 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 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 ## 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 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 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 sub document_uri ($;$) {
410 $_[0]->{document_uri} = $_[1] if @_ > 1;
411 return $_[0]->{document_uri};
412 }
413
414 package Whatpm::NanoDOM::Element;
415 push our @ISA, 'Whatpm::NanoDOM::Node';
416
417 sub new ($$$$$) {
418 my $self = shift->SUPER::new;
419 $self->{owner_document} = shift;
420 Scalar::Util::weaken ($self->{owner_document});
421 $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 sub owner_document ($) {
430 return shift->{owner_document};
431 } # owner_document
432
433 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 my $text = Whatpm::NanoDOM::Text->new (shift);
463 $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 sub local_name ($) { # TODO: HTML5 case
481 return shift->{local_name};
482 } # local_name
483
484 sub manakai_local_name ($) {
485 return shift->{local_name}; # no case fixing for HTML5
486 } # manakai_local_name
487
488 sub namespace_uri ($) {
489 return shift->{namespace_uri};
490 } # namespace_uri
491
492 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 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 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 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 sub has_attribute_ns ($$$) {
535 my ($self, $nsuri, $ln) = @_;
536 $nsuri = '' unless defined $nsuri;
537 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 = Whatpm::NanoDOM::Attr->new ($self, $nsuri, $qn->[0], $qn->[1], $value);
546 } # set_attribute_ns
547
548 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 package Whatpm::NanoDOM::Attr;
558 push our @ISA, 'Whatpm::NanoDOM::Node';
559
560 sub new ($$$$$$) {
561 my $self = shift->SUPER::new;
562 $self->{owner_element} = shift;
563 Scalar::Util::weaken ($self->{owner_element});
564 $self->{namespace_uri} = shift;
565 $self->{prefix} = shift;
566 $self->{local_name} = shift;
567 $self->{value} = shift;
568 $self->{specified} = 1;
569 return $self;
570 } # new
571
572 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 sub node_type { 2 }
581
582 sub owner_document ($) {
583 return shift->owner_element->owner_document;
584 } # owner_document
585
586 ## 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 sub value ($;$) {
597 if (@_ > 1) {
598 $_[0]->{value} = $_[1];
599 }
600 return shift->{value};
601 } # value
602
603 sub owner_element ($) {
604 return shift->{owner_element};
605 } # owner_element
606
607 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 package Whatpm::NanoDOM::CharacterData;
618 push our @ISA, 'Whatpm::NanoDOM::Node';
619
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 package Whatpm::NanoDOM::Text;
637 push our @ISA, 'Whatpm::NanoDOM::CharacterData';
638
639 sub node_type () { 3 }
640
641 package Whatpm::NanoDOM::Comment;
642 push our @ISA, 'Whatpm::NanoDOM::CharacterData';
643
644 sub node_type () { 8 }
645
646 package Whatpm::NanoDOM::DocumentType;
647 push our @ISA, 'Whatpm::NanoDOM::Node';
648
649 sub new ($$) {
650 my $self = shift->SUPER::new;
651 $self->{name} = shift;
652 $self->{element_types} = {};
653 $self->{entities} = {};
654 $self->{notations} = {};
655 $self->{child_nodes} = [];
656 return $self;
657 } # new
658
659 sub node_type () { 10 }
660
661 sub name ($) {
662 return shift->{name};
663 } # name
664
665 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 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 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 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 $self->{child_nodes} = [];
742 return $self;
743 } # new
744
745 sub node_type () { 6 }
746
747 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 sub notation_name ($;$) {
758 $_[0]->{notation_name} = $_[1] if @_ > 1;
759 return $_[0]->{notation_name};
760 } # notation_name
761
762 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 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 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 $self->{allowed_tokens} = [];
818 return $self;
819 } # new
820
821 sub node_type () { 81002 }
822
823 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 =head1 SEE ALSO
836
837 L<Whatpm::HTML|Whatpm::HTML>
838
839 L<Whatpm::XML::Parser|Whatpm::XML::Parser>
840
841 L<Whatpm::ContentChecker|Whatpm::ContentChecker>
842
843 =head1 AUTHOR
844
845 Wakaba <w@suika.fam.cx>.
846
847 =head1 LICENSE
848
849 Copyright 2007-2008 Wakaba <w@suika.fam.cx>
850
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 # $Date: 2008/11/07 08:45:28 $

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24