/[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 - (show 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 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