/[suikacvs]/messaging/manakai/lib/Message/DOM/Node.pm
Suika

Contents of /messaging/manakai/lib/Message/DOM/Node.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.7 - (hide annotations) (download)
Sun Jun 17 13:37:40 2007 UTC (17 years, 5 months ago) by wakaba
Branch: MAIN
Changes since 1.6: +72 -20 lines
++ manakai/t/ChangeLog	17 Jun 2007 13:37:22 -0000
2007-06-17  Wakaba  <wakaba@suika.fam.cx>

	* DOM-Attr.t, DOM-AttributeDefinition.t, DOM-DocumentType.t,
	DOM-Element.t, DOM-Entity.t, DOM-EntityReference.t,
	DOM-Notation.t, DOM-ProcessingInstruction.t: New.

	* DOM-Document.t, DOM-Node.t: Tests for newly-implemented attributes
	and methods are added.

	* Makefile (test-module-dom-old): Renamed from |test-module-dom|.
	(test-module-dom): New.

++ manakai/lib/Message/DOM/ChangeLog	17 Jun 2007 13:34:54 -0000
2007-06-17  Wakaba  <wakaba@suika.fam.cx>

	* Attr.pm (____new): Initialize |specified| as 1.
	(base_uri, manakai_attribute_type, specified): Implemented.
	(prefix): Don't check read-only flag unless |strict_error_checking|.
	(value): Call |text_content| for now.

	* AttributeDefinition.pm (DeclaredValueType, DefaultValueType): Added.
	(declared_type, default_type): Implemented.

	* CharacterData.pm (____new): Allow a scalar reference
	as an input for the |data| attribute.
	(base_uri, manakai_append_text): Implemented.

	* DOMConfiguration.pm (set_parameter): Resetting implemented.

	* DOMDocument.pm (____new): Set default values to
	configuration parameter whose default is true.
	(document_uri, input_encoding): Implemented.
	(all_declarations_processed, manakai_is_html): Implemented.
	(base_uri, manakai_append_text,
	manakai_entity_base_uri, strict_error_checking,
	xml_encoding, xml_version, xml_standalone): Implemented.

	* DOMElement.pm (manakai_base_uri, base_uri): Implemented.
	(get_attribute, get_attribute_node): Alpha version.
	(set_attribute_node, set_attribute_node_ns): Implemented.
	(set_attribute_ns): Accept non-ARRAY qualified name.

	* DOMException.pm (___error_def): |WRONG_DOCUMENT_ERR|,
	|NOT_SUPPORTED_ERR|, and |INUSE_ATTRIBUTE_ERR| are added.

	* DocumentType.pm (public_id, system_id): Implemented.
	(base_uri, declaration_base_uri, manakai_declaration_base_uri,
	manakai_append_text): Implemented.
	(element_types, general_entities, notations,
	set_element_type_definition_node, set_general_entity_node,
	set_notation_node): Alpha version.

	* ElementTypeDefinition.pm (manakai_append_text): Implemented.
	(attribute_definitions, set_attribute_definition_node): Alpha version.

	* Entity.pm (has_replacement_tree, public_id, system_id,
	manakai_declaration_base_uri, manakai_entity_base_uri,
	manakai_entity_uri): Implemented.

	* EntityReference.pm (manakai_expanded, manakai_external): Implemented.
	(base_uri, manakai_entity_base_uri): Implemented.

	* Node.pm (base_uri): Implemented.
	(text_content): Don't check read-only or not
	unless |strict_error_checking|.
	(manakai_append_text): Implemented.
	(get_feature): Alpha.
	(manakai_set_read_only): Implemented.

	* Notation.pm (public_id, system_id, manakai_append_text,
	manakai_declaration_base_uri): Implemented.

	* ProcessingInstruction.pm (manakai_base_uri,
	base_uri, manakai_append_text): Implemented.

1 wakaba 1.1 package Message::DOM::Node;
2     use strict;
3 wakaba 1.7 our $VERSION=do{my @r=(q$Revision: 1.6 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
4 wakaba 1.1 push our @ISA, 'Message::IF::Node';
5     require Scalar::Util;
6 wakaba 1.6 require Message::DOM::DOMException;
7 wakaba 1.1
8 wakaba 1.4 ## NOTE:
9     ## Node
10     ## + Attr (2)
11     ## + AttributeDefinition (81002)
12     ## + CharacterData
13     ## + Comment (8)
14     ## + Text (3)
15     ## + CDATASection (4)
16     ## + Document (9)
17     ## + DocumentFragment (11)
18     ## + DocumentType (10)
19     ## + Element (1)
20     ## + ElementTypeDefinition (81001)
21     ## + Entity (6)
22     ## + EntityReference (5)
23     ## + Notation (12)
24     ## + ProcessingInstruction (7)
25    
26     use overload
27     '==' => sub {
28     return 0 unless UNIVERSAL::isa ($_[0], 'Message::IF::Node');
29     ## TODO: implement is_equal_node
30     return $_[0]->is_equal_node ($_[1]);
31     },
32     '!=' => sub {
33     return not ($_[0] == $_[1]);
34     },
35     fallback => 1;
36    
37 wakaba 1.2 ## The |Node| interface - constants
38    
39     ## Definition group NodeType
40    
41     ## NOTE: Numeric codes up to 200 are reserved by W3C [DOM1SE, DOM2, DOM3].
42    
43     sub ELEMENT_NODE () { 1 }
44     sub ATTRIBUTE_NODE () { 2 }
45     sub TEXT_NODE () { 3 }
46     sub CDATA_SECTION_NODE () { 4 }
47     sub ENTITY_REFERENCE_NODE () { 5 }
48     sub ENTITY_NODE () { 6 }
49     sub PROCESSING_INSTRUCTION_NODE () { 7 }
50     sub COMMENT_NODE () { 8 }
51     sub DOCUMENT_NODE () { 9 }
52     sub DOCUMENT_TYPE_NODE () { 10 }
53     sub DOCUMENT_FRAGMENT_NODE () { 11 }
54     sub NOTATION_NODE () { 12 }
55     sub ELEMENT_TYPE_DEFINITION_NODE () { 81001 }
56     sub ATTRIBUTE_DEFINITION_NODE () { 81002 }
57    
58     ## Definition group DocumentPosition
59    
60     ## Spec:
61     ## <http://www.w3.org/TR/2004/REC-DOM-Level-3-Core-20040407/core.html#DocumentPosition>
62    
63     sub DOCUMENT_POSITION_DISCONNECTED () { 0x01 }
64     sub DOCUMENT_POSITION_PRECEDING () { 0x02 }
65     sub DOCUMENT_POSITION_FOLLOWING () { 0x04 }
66     sub DOCUMENT_POSITION_CONTAINS () { 0x08 }
67     sub DOCUMENT_POSITION_CONTAINED_BY () { 0x10 }
68     sub DOCUMENT_POSITION_IMPLEMENTATION_SPECIFIC () { 0x20 }
69    
70 wakaba 1.1 sub ____new ($$) {
71     my $self = bless \({}), shift;
72     $$self->{owner_document} = shift;
73     Scalar::Util::weaken ($$self->{owner_document});
74     return $self;
75     } # ____new
76    
77 wakaba 1.6 sub ___report_error ($$) {
78     $_[1]->throw;
79     } # ___report_error
80    
81 wakaba 1.1 sub AUTOLOAD {
82     my $method_name = our $AUTOLOAD;
83     $method_name =~ s/.*:://;
84     return if $method_name eq 'DESTROY';
85    
86     if ({
87     ## Read-only attributes (trivial accessors)
88     owner_document => 1,
89     parent_node => 1,
90 wakaba 1.4 manakai_read_only => 1,
91 wakaba 1.1 }->{$method_name}) {
92     no strict 'refs';
93     eval qq{
94     sub $method_name (\$) {
95     return \${\$_[0]}->{$method_name};
96     }
97     };
98     goto &{ $AUTOLOAD };
99     } elsif ({
100     ## Read-write attributes (DOMString, trivial accessors)
101     }->{$method_name}) {
102     no strict 'refs';
103     eval qq{
104 wakaba 1.2 sub $method_name (\$;\$) {
105 wakaba 1.1 if (\@_ > 1) {
106 wakaba 1.2 \${\$_[0]}->{$method_name} = ''.\$_[1];
107 wakaba 1.1 }
108     return \${\$_[0]}->{$method_name};
109     }
110     };
111     goto &{ $AUTOLOAD };
112     } else {
113     require Carp;
114     Carp::croak (qq<Can't locate method "$AUTOLOAD">);
115     }
116     } # AUTOLOAD
117    
118 wakaba 1.6 ## |Node| attributes
119 wakaba 1.1
120 wakaba 1.6 ## NOTE: Overridden by |Element|.
121     sub attributes () { undef }
122 wakaba 1.2
123 wakaba 1.7 sub base_uri ($) {
124     ## NOTE: Overridden by |Attr|, |CharacterData|, |Document|, |DocumentType|,
125     ## |Element|, |EntityReference|, and |ProcessingInstruction|.
126    
127     local $Error::Depth = $Error::Depth + 1;
128     return $_[0]->owner_document->base_uri;
129     } # base_uri
130 wakaba 1.3
131     sub child_nodes ($) {
132 wakaba 1.6 ## NOTE: Overridden by |CharacterData|, |ElementTypeDefinition|,
133     ## |Notation|, and |ProcessingInstruction|.
134 wakaba 1.4 require Message::DOM::NodeList;
135     return bless \\($_[0]), 'Message::DOM::NodeList::ChildNodeList';
136 wakaba 1.3 } # child_nodes
137    
138     sub first_child ($) {
139     my $self = shift;
140     return $$self->{child_nodes} ? $$self->{child_nodes}->[0] : undef;
141     } # first_child
142    
143     sub last_child ($) {
144     my $self = shift;
145     return $$self->{child_nodes} && $$self->{child_nodes}->[0]
146     ? $$self->{child_nodes}->[-1] : undef;
147     } # last_child
148    
149 wakaba 1.6 sub local_name { undef }
150 wakaba 1.3
151 wakaba 1.6 sub manakai_local_name { undef }
152    
153     sub namespace_uri { undef }
154 wakaba 1.3
155     sub next_sibling ($) {
156     my $self = shift;
157     my $parent = $$self->{parent_node};
158     return undef unless defined $parent;
159     my $has_self;
160     for (@{$parent->child_nodes}) {
161     if ($_ eq $self) {
162     $has_self = 1;
163     } elsif ($has_self) {
164     return $_;
165     }
166     }
167     return undef;
168     } # next_sibling
169 wakaba 1.2
170 wakaba 1.6 ## NOTE: Overridden by subclasses.
171     sub node_name () { undef }
172 wakaba 1.2
173 wakaba 1.6 ## NOTE: Overridden by subclasses.
174     sub node_type () { }
175 wakaba 1.2
176 wakaba 1.6 ## NOTE: Overridden by |Attr|, |AttributeDefinition|,
177     ## |CharacterData|, and |ProcessingInstruction|.
178     sub node_value () { undef }
179 wakaba 1.3
180     sub owner_document ($);
181    
182     sub parent_node ($);
183    
184 wakaba 1.6 ## NOTE: Overridden by |Element| and |Attr|.
185 wakaba 1.3 sub prefix ($;$) { undef }
186    
187     sub previous_sibling ($) {
188     my $self = shift;
189     my $parent = $$self->{parent_node};
190     return undef unless defined $parent;
191     my $prev;
192     for (@{$parent->child_nodes}) {
193     if ($_ eq $self) {
194     return $prev;
195     } else {
196     $prev = $_;
197     }
198     }
199     return undef;
200     } # previous_sibling
201    
202 wakaba 1.4 sub manakai_read_only ($);
203    
204 wakaba 1.3 sub text_content ($;$) {
205 wakaba 1.6 ## NOTE: For |Element|, |Attr|, |Entity|, |EntityReference|,
206     ## |DocumentFragment|, and |AttributeDefinition|. In addition,
207     ## |Document|'s |text_content| might call this attribute.
208    
209     ## NOTE: Overridden by |Document|, |DocumentType|, |Notation|,
210     ## |CharacterData|, |ProcessingInstruction|, and |ElementTypeDefinition|.
211    
212     my $self = $_[0];
213    
214     if (@_ > 1) {
215 wakaba 1.7 if (${$$self->{owner_document} or $self}->{strict_error_checking} and
216     $$self->{manakai_read_only}) {
217 wakaba 1.6 report Message::DOM::DOMException
218     -object => $self,
219     -type => 'NO_MODIFICATION_ALLOWED_ERR',
220     -subtype => 'READ_ONLY_NODE_ERR';
221     }
222    
223     local $Error::Depth = $Error::Depth + 1;
224     @{$self->child_nodes} = ();
225     if (defined $_[1] and length $_[1]) {
226     ## NOTE: |DocumentType| don't use this code.
227     my $text = ($$self->{owner_document} || $self)->create_text_node ($_[1]);
228     $self->append_child ($text);
229     }
230     }
231    
232     if (defined wantarray) {
233     local $Error::Depth = $Error::Depth + 1;
234     my $r = '';
235     my @node = @{$self->child_nodes};
236     while (@node) {
237     my $child = shift @node;
238     my $child_nt = $child->node_type;
239     if ($child_nt == TEXT_NODE or $child_nt == CDATA_SECTION_NODE) {
240     $r .= $child->node_value unless $child->is_element_content_whitespace;
241     } elsif ($child_nt == COMMENT_NODE or
242     $child_nt == PROCESSING_INSTRUCTION_NODE or
243     $child_nt == DOCUMENT_TYPE_NODE) {
244     #
245     } else {
246     unshift @node, @{$child->child_nodes};
247     }
248     }
249     return $r;
250     }
251 wakaba 1.3 } # text_content
252    
253 wakaba 1.7 ## |Node| methods
254    
255 wakaba 1.4 ## TODO:
256     sub is_same_node ($$) {
257     return $_[0] eq $_[1];
258     } # is_same_node
259    
260     ## TODO:
261 wakaba 1.1 sub is_equal_node ($$) {
262 wakaba 1.4 return $_[0]->node_name eq $_[1]->node_name &&
263     $_[0]->node_value eq $_[1]->node_value;
264 wakaba 1.1 } # is_equal_node
265    
266     sub manakai_parent_element ($) {
267     my $self = shift;
268     my $parent = $$self->{parent_node};
269     while (defined $parent) {
270     if ($parent->node_type == 1) { # ELEMENT_NODE
271     return $parent;
272     } else {
273     $parent = $$parent->{parent_node};
274     }
275     }
276     return undef;
277     } # manakai_parent_element
278    
279     ## NOTE: Only applied to Elements and Documents
280     sub append_child ($$) {
281     my ($self, $new_child) = @_;
282     if (defined $$new_child->{parent_node}) {
283 wakaba 1.5 my $parent_list = ${$$new_child->{parent_node}}->{child_nodes};
284 wakaba 1.1 for (0..$#$parent_list) {
285     if ($parent_list->[$_] eq $new_child) {
286     splice @$parent_list, $_, 1;
287 wakaba 1.7 last;
288 wakaba 1.1 }
289     }
290     }
291     push @{$$self->{child_nodes}}, $new_child;
292     $$new_child->{parent_node} = $self;
293     Scalar::Util::weaken ($$new_child->{parent_node});
294 wakaba 1.7 ## TODO:
295     $$new_child->{owner_document} = $self if $self->node_type == DOCUMENT_NODE;
296 wakaba 1.1 return $new_child;
297     } # append_child
298    
299 wakaba 1.7 sub manakai_append_text ($$) {
300     ## NOTE: For |Element|, |Attr|, |Entity|, |EntityReference|,
301     ## |DocumentFragment|, and |AttributeDefinition|. In addition,
302     ## |Document|'s |text_content| might call this attribute.
303    
304     ## NOTE: Overridden by |Document|, |DocumentType|, |CharacterData|,
305     ## |ElementTypeDefinition|, |Notation|, and |ProcessingInstruction|.
306    
307     my $self = $_[0];
308     local $Error::Depth = $Error::Depth + 1;
309     if (@{$$self->{child_nodes}} and
310     $$self->{child_nodes}->[-1]->node_type == TEXT_NODE) {
311     $$self->{child_nodes}->[-1]->manakai_append_text ($_[1]);
312     } else {
313     my $text = ($$self->{owner_document} or $self)->create_text_node ($_[1]);
314     $self->append_child ($text);
315     }
316     } # manakai_append_text
317    
318     sub get_feature {
319     ## TODO:
320     return $_[0];
321     }
322    
323 wakaba 1.1 ## NOTE: Only applied to Elements and Documents
324     sub insert_before ($$;$) {
325     my ($self, $new_child, $ref_child) = @_;
326     if (defined $$new_child->{parent_node}) {
327 wakaba 1.5 my $parent_list = ${$$new_child->{parent_node}}->{child_nodes};
328 wakaba 1.1 for (0..$#$parent_list) {
329     if ($parent_list->[$_] eq $new_child) {
330     splice @$parent_list, $_, 1;
331 wakaba 1.7 last;
332 wakaba 1.1 }
333     }
334     }
335     my $i = @{$$self->{child_nodes}};
336     if (defined $ref_child) {
337     for (0..$#{$$self->{child_nodes}}) {
338     if ($$self->{child_nodes}->[$_] eq $ref_child) {
339     $i = $_;
340     last;
341     }
342     }
343     }
344     splice @{$$self->{child_nodes}}, $i, 0, $new_child;
345     $$new_child->{parent_node} = $self;
346     Scalar::Util::weaken ($$new_child->{parent_node});
347     return $new_child;
348     } # insert_before
349    
350     ## NOTE: Only applied to Elements and Documents
351     sub remove_child ($$) {
352     my ($self, $old_child) = @_;
353     my $parent_list = $$self->{child_nodes};
354     for (0..$#$parent_list) {
355     if ($parent_list->[$_] eq $old_child) {
356     splice @$parent_list, $_, 1;
357 wakaba 1.7 last;
358 wakaba 1.1 }
359     }
360     delete $$old_child->{parent_node};
361     return $old_child;
362     } # remove_child
363    
364     ## NOTE: Only applied to Elements and Documents
365     sub has_child_nodes ($) {
366     return @{${+shift}->{child_nodes}} > 0;
367     } # has_child_nodes
368    
369 wakaba 1.4 sub manakai_set_read_only ($;$$) {
370 wakaba 1.7 my $value = 1 if $_[1];
371     if ($_[2]) {
372     my @target = ($_[0]);
373     while (@target) {
374     my $target = shift @target;
375     if ($value) {
376     $$target->{manakai_read_only} = 1;
377     } else {
378     delete $$target->{manakai_read_only};
379     }
380     push @target, @{$target->child_nodes};
381    
382     my $nt = $target->node_type;
383     if ($nt == ELEMENT_NODE) {
384     push @target, @{$target->attributes};
385     } elsif ($nt == ELEMENT_TYPE_DEFINITION_NODE) {
386     push @target, @{$target->attribute_definitions};
387     } elsif ($nt == DOCUMENT_TYPE_NODE) {
388     push @target, @{$target->element_types};
389     push @target, @{$target->general_entities};
390     push @target, @{$target->notations};
391     }
392     }
393     } else { # not deep
394     if ($value) {
395     ${$_[0]}->{manakai_read_only} = 1;
396     } else {
397     delete ${$_[0]}->{manakai_read_only};
398     }
399     }
400 wakaba 1.4 } # manakai_set_read_only
401    
402     package Message::IF::Node;
403    
404     =head1 LICENSE
405 wakaba 1.1
406 wakaba 1.4 Copyright 2007 Wakaba <w@suika.fam.cx>
407 wakaba 1.1
408 wakaba 1.4 This program is free software; you can redistribute it and/or
409     modify it under the same terms as Perl itself.
410 wakaba 1.1
411 wakaba 1.4 =cut
412 wakaba 1.1
413     1;
414 wakaba 1.7 ## $Date: 2007/06/16 15:27:45 $

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24