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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (hide annotations) (download)
Sat Jul 14 16:32:28 2007 UTC (17 years, 4 months ago) by wakaba
Branch: MAIN
CVS Tags: manakai-release-0-4-0, HEAD
++ manakai/t/ChangeLog	14 Jul 2007 16:32:13 -0000
2007-07-15  Wakaba  <wakaba@suika.fam.cx>

	* DOM-TreeWalker.t, DOM-SerialWalker.t: New test scripts.

	* DOM-DOMImplementation.t: Tests for |Traversal| feature
	are added.

	* DOM-Node.t: Tests for |Traversal| feature are added.

++ manakai/lib/Message/DOM/ChangeLog	14 Jul 2007 16:31:23 -0000
2007-07-15  Wakaba  <wakaba@suika.fam.cx>

	* TreeWalker.pm, SerialWalker.pm: New Perl modules.

	* Text.pm (whole_text): Parameter index number has
	been changed to support new |NodeFilter| Perl binding
	definition.

2007-07-14  Wakaba  <wakaba@suika.fam.cx>

	* AttributeDefinition.pm, DOMElement.pm, DocumentType.pm,
	ElementTypeDefinition.pm, Entity.pm, EntityReference.pm,
	Notation.pm, ProcessingInstruction.pm (AUTOLOAD): Don't croak even if an attempt is made to modify a read-only attribute.

	* DOMConfiguration.pm (can_set_parameter,
	set_parameter): Don't allow to set the value
	to a string other than <http://www.w3.org/TR/REC-xml> (XML 1.0 DTD).

	* DOMDocument.pm (Message::IF::DocumentTraversal): New interface.
	(create_tree_walker, manakai_create_serial_walker): References
	and prototypes are added.

	* DOMException.pm (NULLPO_ERR): New error type:-).

	* DOMImplementation.pm ($HasFeature): Feature |Traversal|,
	version |2.0|, is added.

1 wakaba 1.1 package Message::DOM::TreeWalker;
2     use strict;
3     our $VERSION=do{my @r=(q$Revision: 1.8 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
4     push our @ISA, 'Message::IF::TreeWalker';
5    
6     sub AUTOLOAD {
7     my $method_name = our $AUTOLOAD;
8     $method_name =~ s/.*:://;
9     return if $method_name eq 'DESTROY';
10    
11     if ({
12     expand_entity_references => 1,
13     filter => 1,
14     root => 1,
15     what_to_show => 1,
16     }->{$method_name}) {
17     no strict 'refs';
18     eval qq{
19     sub $method_name (\$) { \$_[0]->{$method_name} }
20     };
21     goto &{ $AUTOLOAD };
22     } else {
23     require Carp;
24     Carp::croak (qq<Can't locate method "$AUTOLOAD">);
25     }
26     } # AUTOLOAD
27    
28     sub ___report_error ($$) { $_[1]->throw }
29    
30     ## TODO: Documentation
31     sub clone ($) {
32     return bless {%{$_[0]}}, ref $_[0];
33     } # clone
34    
35     ## |TreeWalker| attributes
36    
37     sub current_node ($;$) {
38     if (@_ > 1) {
39     if (defined $_[1]) {
40     $_[0]->{current_node} = $_[1];
41     } else {
42     require Message::DOM::DOMException;
43     report Message::DOM::DOMException
44     -object => $_[0],
45     -type => 'NOT_SUPPORTED_ERR',
46     -subtype => 'NULLPO_ERR';
47     }
48     }
49    
50     return $_[0]->{current_node};
51     } # current_node
52    
53     sub expand_entity_references ($);
54    
55     sub filter ($);
56    
57     sub root ($);
58    
59     sub what_to_show ($);
60    
61     ## |TreeWalker| methods
62    
63     sub first_child ($) {
64     local $Error::Depth = $Error::Depth + 1;
65    
66     my $sresult = $_[0]->_test_node ($_[0]->{current_node});
67    
68     if ($sresult != 12101) { # MANAKAI_FILTER_OPAQUE
69     my @target = (@{$_[0]->{current_node}->child_nodes});
70     A: while (@target) {
71     my $target = shift @target;
72     my $result = $_[0]->_test_node ($target);
73     if ($result == 1 or $result == 12101) {
74     # FILTER_ACCEPT, MANAKAI_FILTER_OPAQUE
75     return ($_[0]->{current_node} = $target);
76     } elsif ($result == 3) { # FILTER_SKIP
77     unshift @target, @{$target->child_nodes};
78     }
79     } # A
80     } # not opaque
81    
82     return undef;
83     } # first_child
84    
85     sub last_child ($) {
86     local $Error::Depth = $Error::Depth + 1;
87    
88     my $sresult = $_[0]->_test_node ($_[0]->{current_node});
89     if ($sresult != 12101) { # MANAKAI_FILTER_OPAQUE
90     my @target = (@{$_[0]->{current_node}->child_nodes});
91     A: while (@target) {
92     my $target = pop @target;
93     my $result = $_[0]->_test_node ($target);
94     if ($result == 1 or $result == 12101) {
95     # FILTER_ACCEPT, MANAKAI_FILTER_OPAQUE
96     return ($_[0]->{current_node} = $target);
97     } elsif ($result == 3) { # FILTER_SKIP
98     push @target, @{$target->child_nodes};
99     }
100     } # A
101     }
102    
103     return undef;
104     } # last_child
105    
106     sub next_node ($) {
107     local $Error::Depth = $Error::Depth + 1;
108    
109     my $target = $_[0]->{current_node};
110     my $tw = $_[0]->clone;
111     $tw->{current_node} = $target;
112     $tw->{root} = $target;
113     my $fc = $tw->first_child;
114     if (defined $fc) {
115     return ($_[0]->{current_node} = $fc);
116     }
117    
118     while (defined $target) {
119     my $current = $target;
120     undef $target;
121     P: while (defined $current and not $current eq $_[0]->{root}) {
122     $target = $current->next_sibling;
123     last P if defined $target;
124     $current = $current->parent_node;
125     } # P
126     return undef unless defined $target;
127    
128     my $result = $_[0]->_test_node ($target);
129     if ($result == 1 or $result == 12101) {
130     # FILTER_ACCEPT, MANAKAI_FILTER_OPAQUE
131     return ($_[0]->{current_node} = $target);
132     } elsif ($result == 3) { # FILTER_SKIP
133     my $tw = $_[0]->clone;
134     $tw->{current_node} = $target;
135     $tw->{root} = $target;
136     my $fc = $tw->first_child;
137     if (defined $fc) {
138     return ($_[0]->{current_node} = $fc);
139     }
140     }
141     }
142    
143     return undef;
144     } # next_node
145    
146     sub next_sibling ($) {
147     local $Error::Depth = $Error::Depth + 1;
148    
149     my $target = $_[0]->{current_node};
150     while (defined $target) {
151     my $current = $target;
152     undef $target;
153     P: while (defined $current and not $current eq $_[0]->{root}) {
154     $target = $current->next_sibling;
155     last P if defined $target;
156     $current = $current->parent_node;
157     last P unless defined $current;
158     my $presult = $_[0]->_test_node ($current);
159     last P if $presult != 3; # FILTER_SKIP
160     } # P
161     return undef unless defined $target;
162    
163     my $result = $_[0]->_test_node ($target);
164     if ($result == 1 or $result == 12101) {
165     # FILTER_ACCEPT, MANAKAI_FILTER_OPAQUE
166     return ($_[0]->{current_node} = $target);
167     } elsif ($result == 3) { # FILTER_SKIP
168     my $tw = $_[0]->clone;
169     $tw->{current_node} = $target;
170     $tw->{root} = $target;
171     my $fc = $tw->first_child;
172     if (defined $fc) {
173     return ($_[0]->{current_node} = $fc);
174     }
175     }
176     }
177    
178     return undef;
179     } # next_sibling
180    
181     sub parent_node ($) {
182     local $Error::Depth = $Error::Depth + 1;
183    
184     unless ($_[0]->{current_node} eq $_[0]->{root}) {
185     my $target = $_[0]->{current_node}->parent_node;
186     T: while (defined $target) {
187     my $result = $_[0]->_test_node ($target);
188     if ($result == 1 or $result == 12101) {
189     # FILTER_ACCEPT, MANAKAI_FILTER_OPAQUE
190     return ($_[0]->{current_node} = $target);
191     } elsif ($target eq $_[0]->{root}) {
192     return undef;
193     }
194     $target = $target->parent_node;
195     } # T
196     }
197    
198     return undef;
199     } # parent_node
200    
201     sub previous_node ($) {
202     local $Error::Depth = $Error::Depth + 1;
203    
204     my $target = $_[0]->{current_node};
205     T: {
206     return undef if $target eq $_[0]->{root};
207    
208     P: {
209     my $ptarget = $target->previous_sibling;
210     if (defined $ptarget) {
211     my $result = $_[0]->_test_node ($ptarget);
212     if ($result == 12101) { # MANAKAI_FILTER_OPAQUE
213     return ($_[0]->{current_node} = $ptarget);
214     } elsif ($result != 2) { # FILTER_REJECT
215     my $tw = $_[0]->clone;
216     $tw->{current_node} = $ptarget;
217     $tw->{root} = $ptarget;
218     my $lc = $tw->last_child;
219     return ($_[0]->{current_node} = defined $lc ? $lc : $ptarget);
220     } else {
221     $target = $ptarget;
222     redo P;
223     }
224     }
225     } # P
226    
227     my $ptarget = $target->parent_node;
228     if (defined $ptarget) {
229     my $result = $_[0]->_test_node ($ptarget);
230     if ($result == 1 or $result == 12101) {
231     # FILTER_ACCEPT, MANAKAI_FILTER_OPAQUE
232     return ($_[0]->{current_node} = $ptarget);
233     } else {
234     $target = $ptarget;
235     redo T;
236     }
237     }
238     } # T
239    
240     return undef;
241     } # previous_node
242    
243     sub previous_sibling ($) {
244     local $Error::Depth = $Error::Depth + 1;
245    
246     my $target = $_[0]->{current_node};
247     while (defined $target) {
248     my $current = $target;
249     undef $target;
250     P: while (defined $current and not $current eq $_[0]->{root}) {
251     $target = $current->previous_sibling;
252     last P if defined $target;
253    
254     $current = $current->parent_node;
255     last P unless defined $current;
256     my $presult = $_[0]->_test_node ($current);
257     if ($presult != 3 and $presult != 2) { # FILTER_SKIP, FILTER_REJECT
258     last P;
259     }
260     } # P
261     return undef unless defined $target;
262    
263     my $result = $_[0]->_test_node ($target);
264     if ($result == 1 or $result == 12101) {
265     # FILTER_ACCEPT, MANAKAI_FILTER_OPAQUE
266     return ($_[0]->{current_node} = $target);
267     } elsif ($result == 3) { # FILTER_SKIP
268     my $tw = $_[0]->clone;
269     $tw->{current_node} = $target;
270     $tw->{root} = $target;
271     my $fc = $tw->last_child;
272     if (defined $fc) {
273     return ($_[0]->{current_node} = $fc);
274     }
275     }
276     }
277    
278     return undef;
279     } # previous_sibling
280    
281     ## TODO: Document Perl binding for |NodeFilter|.
282     ## TODO: |NodeFilter| constants...
283    
284     sub _test_node ($$) {
285     ## NOTE: There is a code clone in |SerialWalker.pm|.
286    
287     unless ($_[0]->{expand_entity_references}) {
288     my $parent = $_[1]->parent_node;
289     if (defined $parent and $parent->node_type == 5) { # ENTITY_REFERENCE_NODE
290     return 2; # FILTER_REJECT ## NOTE: Even if |NodeIterator|.
291     }
292     }
293    
294     if ($_[0]->{what_to_show} != 0xFFFFFFFF) { # SHOW_ALL
295     my $nt = $_[1]->node_type;
296     if ($nt < 33 and ($_[0]->{what_to_show} & (1 << ($nt-1)))) {
297     #
298     } else {
299     return 3; # FILTER_SKIP
300     }
301     }
302    
303     if (defined $_[0]->{filter}) {
304     local $Error::Depth = $Error::Depth + 1;
305     return $_[0]->{filter}->($_[1]);
306     } else {
307     return 1; # FILTER_ACCEPT
308     }
309     } # _test_node
310    
311     package Message::IF::TreeWalker;
312    
313     package Message::DOM::Document;
314    
315     sub create_tree_walker ($$;$$$) {
316     unless (defined $_[1]) {
317     require Message::DOM::DOMException;
318     report Message::DOM::DOMException
319     -object => $_[0],
320     -type => 'NOT_SUPPORTED_ERR',
321     -subtype => 'NULLPO_ERR';
322     }
323    
324     return bless {
325     root => $_[1],
326     what_to_show => 0+($_[2] or 0),
327     filter => $_[3],
328     expand_entity_references => $_[4] ? 1 : 0,
329     current_node => $_[1],
330     }, 'Message::DOM::TreeWalker';
331     } # create_tree_walker
332    
333     =pod
334    
335     TODO: Documentation...
336    
337     FirstChild:
338     If the <IF::NodeFilter>, if any, returns
339     <C::NodeFilter.MANAKAI_FILTER_OPAQUE> for the
340     <A::TreeWalker.currentNode>, this method
341     <kwd:MUST> return <DOM::null>.
342    
343     {NOTE::
344     By definition, the parent of the
345     <M::TreeWalker.firstChild> node, if any, is
346     either a child of the <A::TreeWalker.currentNode>
347     or a descendant of the <A::TreeWalker.currentNode>
348     where all ancestors between <A::TreeWalker.currentNode>
349     and that node is <C::NodeFilter.FILTER_SKIP>ped.
350     That means that the only node that might be
351     <C::NodeFilter.MANAKAI_FILTER_OPAQUE> is the
352     <A::TreeWalker.currentNode>.
353     }
354    
355    
356     @L2Method:
357     @@Name: lastChild
358    
359     If the <IF::NodeFilter>, if any, returns
360     <C::NodeFilter.MANAKAI_FILTER_OPAQUE> for the
361     <A::TreeWalker.currentNode>, this method
362     <kwd:MUST> return <DOM::null>.
363    
364     {NOTE::
365     By definition, the parent of the
366     <M::TreeWalker.lastChild> node, if any, is
367     either a child of the <A::TreeWalker.currentNode>
368     or a descendant of the <A::TreeWalker.currentNode>
369     where all ancestors between <A::TreeWalker.currentNode>
370     and that node is <C::NodeFilter.FILTER_SKIP>ped.
371     That means that the only node that might be
372     <C::NodeFilter.MANAKAI_FILTER_OPAQUE> is the
373     <A::TreeWalker.currentNode>.
374     }
375    
376     parentNode:
377     For the purpose of this method, <C::NodeFilter.MANAKAI_FILTER_OPAQUE>
378     <kwd:MUST> be handled by the same way as
379     <C::NodeFilter.FILTER_ACCEPT>.
380    
381     nextNode:
382     If the <A::TreeWalker.currentNode> is marked as
383     <C::NodeFilter.MANAKAI_FILTER_OPAQUE> by the <IF::NodeFilter>,
384     the method <kwd:MUST-NOT> return any descendant of
385     the <A::TreeWalker.currentNode>. Otherwise,
386     it <kwd:MUST> be treated as if <C::NodeFilter.FILTER_ACCEPT>.
387    
388     nextSibling:
389     The <C::NodeFilter.MANAKAI_FILTER_OPAQUE> value <kwd:MUST>
390     be treated as if <C::NodeFilter.FILTER_ACCEPT> is specified.
391    
392     previousNode:
393     This method <kwd:MUST-NOT> return a descendant
394     of a sibling of the <A::TreeWalker.currentNode> if
395     an ancestor between the descendant and the parent
396     of the <A::TreeWalker.currentNode> (exclusive)
397     is marked as <C::NodeFilter.MANAKAI_FILTER_OPAQUE> by
398     the <IF::NodeFilter> if any. If the node that is
399     a candidate to return is an ancestor of the
400     <A::TreeWalker.currentNode>, the <C::NodeFilter.MANAKAI_FILTER_OPAQUE>
401     value returned by a <IF::NodeFilter> <kwd:MUST> be
402     treated as if the <C::NodeFilter.FILTER_ACCEPT> value
403     is returned.
404    
405     previousSibling:
406     If a node that is a candicate to be returned is marked as
407     <C::NodeFilter.MANAKAI_FILTER_OPAQUE>, it <kwd:MUST>
408     be treated as <C::NodeFilter.FILTER_ACCEPT> when the
409     node is a sibling of the <A::TreeWalker.currentNode>,
410     or as in <M::TreeWalker.lastChild> where the
411     <A::TreeWalker.currentNode> would be the sibling
412     of the actual <A::TreeWalker.currentNode> otherwise.
413    
414     @@mConst:
415     @@@Name: MANAKAI_FILTER_OPAQUE
416     @@@intValue: 12101
417     @@@enDesc:
418     Accept the node itself while rejecting its children if any.
419    
420     If the <C::NodeFilter.MANAKAI_FILTER_OPAQUE> value is
421     specified for a node, the node itself <kwd:MUST> be treated
422     as if the <C::NodeFilter.FILTER_ACCEPT> value is specified.
423     However, any descendant of the node <kwd:MUST> be
424     hidden from the logical view as if the
425     <C::NodeFilter.FILTER_REJECT> value is specified for
426     the ancestor node.
427    
428     {NOTE::
429     This value can be used to emulate the
430     <A::TreeWalker.expandEntityReferences> flag.
431     However, unlike that flag, this filtering option
432     makes the engine behave for descendants as if the node is
433     rejected rather than the descendants of the node
434     is rejected.
435     }
436    
437     {ISSUE::
438     Better name? Any verb?
439     }
440    
441     {ISSUE::
442     Interaction to <IF::NodeIterator>s
443     }
444    
445     {NOTE::
446     The <C::Node.ELEMENT_TYPE_DEFINITION_NODE> and
447     <C::Node.ATTRIBUTE_TYPE_DEFINITION> <A::Node.nodeType>s,
448     extended by manakai, has values greater than <CODE::32>
449     so that it cannot be controled by the <CODE::whatToShow>
450     flags.
451     }
452    
453     =head1 LICENSE
454    
455     Copyright 2007 Wakaba <w@suika.fam.cx>
456    
457     This program is free software; you can redistribute it and/or
458     modify it under the same terms as Perl itself.
459    
460     =cut
461    
462     1;
463     ## $Date: 2007/07/14 09:19:11 $

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24