/[suikacvs]/messaging/manakai/lib/Message/Util/ManakaiNode.pm
Suika

Contents of /messaging/manakai/lib/Message/Util/ManakaiNode.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.21 - (hide annotations) (download)
Sun Nov 20 09:49:29 2005 UTC (19 years, 7 months ago) by wakaba
Branch: MAIN
Changes since 1.20: +16 -274 lines
++ manakai/t/ChangeLog	20 Nov 2005 09:49:17 -0000
2005-11-20  Wakaba  <wakaba@suika.fam.cx>

	* .cvsignore: |util-dis-dnlite.t| added.

	* Makefile: Rules for |util-dis-dnlite.t| added.

++ manakai/lib/Message/Util/ChangeLog	20 Nov 2005 09:45:10 -0000
2005-11-20  Wakaba  <wakaba@suika.fam.cx>

	* Makefile: |../DOM/Tree.dis| added.

++ manakai/lib/Message/Util/DIS/ChangeLog	20 Nov 2005 09:47:06 -0000
2005-11-20  Wakaba  <wakaba@suika.fam.cx>

	* DNLite.dis (forMatch): Matching rule revised so that
	multiple specification of same |For| URI with different
	operators work as intended.

	* Perl.dis: Typo fixed.

	* Test.dis: |uri| parameters added.

++ manakai/lib/Message/DOM/ChangeLog	20 Nov 2005 09:38:53 -0000
2005-11-20  Wakaba  <wakaba@suika.fam.cx>

	* DOMMain.dis: Unused declarations and definitions removed.

	* DOMCore.dis: DOM document tree related interfaces removed.

	* Tree.dis: New module separated from |DOMCore.dis|.

	* DOMXML.dis: Some referent changed to |Tree.dis|.

	* Makefile: |Tree.dis| added.

1 wakaba 1.1 #!/usr/bin/perl
2     ## This file is automatically generated
3 wakaba 1.21 ## at 2005-11-20T09:27:08+00:00,
4 wakaba 1.1 ## from file "lib/Message/Util/ManakaiNode.dis",
5     ## module <http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/ManakaiNode>,
6     ## for <http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#Perl>.
7     ## Don't edit by hand!
8     use strict;
9     package Message::Util::ManakaiNode;
10 wakaba 1.21 our $VERSION = 20051120.0927;
11 wakaba 1.19 package Message::Util::IF::NodeStem;
12 wakaba 1.21 our $VERSION = 20051120.0927;
13 wakaba 1.19 package Message::Util::ManakaiNode::ManakaiNodeStem;
14 wakaba 1.21 our $VERSION = 20051120.0927;
15 wakaba 1.1 push our @ISA, 'Message::Util::IF::NodeStem';
16 wakaba 1.19 sub _new ($$) {
17     my ($self, $className) = @_;
18     my $r;
19 wakaba 1.17
20     {
21    
22 wakaba 1.19 my
23     $grc = 0;
24     $r = bless {
25    
26     't'
27     => $className,
28    
29     'grc'
30     => \$grc,
31    
32     'rc'
33     => 0,
34    
35 wakaba 1.17 'tid'
36 wakaba 1.19 => \ (
37     (
38     'tag:suika.fam.cx,2005-09:' . time . ':' . $$ . ':' .
39     ($Message::Util::ManakaiNode::UniqueIDR ||=
40     [qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z
41     a b c d e f g h i j k l m n o p q r s t u v w x y z
42     0 1 2 3 4 5 6 7 8 9/]->[rand 62] .
43     [qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z
44     a b c d e f g h i j k l m n o p q r s t u v w x y z
45     0 1 2 3 4 5 6 7 8 9/]->[rand 62] .
46     [qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z
47     a b c d e f g h i j k l m n o p q r s t u v w x y z
48     0 1 2 3 4 5 6 7 8 9/]->[rand 62] .
49     [qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z
50     a b c d e f g h i j k l m n o p q r s t u v w x y z
51     0 1 2 3 4 5 6 7 8 9/]->[rand 62] .
52     [qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z
53     a b c d e f g h i j k l m n o p q r s t u v w x y z
54     0 1 2 3 4 5 6 7 8 9/]->[rand 62]) .
55     (++$Message::Util::ManakaiNode::UniqueIDN)
56 wakaba 1.17 )
57 wakaba 1.19 ),
58    
59     'nid'
60     =>
61     (
62     'tag:suika.fam.cx,2005-09:' . time . ':' . $$ . ':' .
63     ($Message::Util::ManakaiNode::UniqueIDR ||=
64     [qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z
65     a b c d e f g h i j k l m n o p q r s t u v w x y z
66     0 1 2 3 4 5 6 7 8 9/]->[rand 62] .
67     [qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z
68     a b c d e f g h i j k l m n o p q r s t u v w x y z
69     0 1 2 3 4 5 6 7 8 9/]->[rand 62] .
70     [qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z
71     a b c d e f g h i j k l m n o p q r s t u v w x y z
72     0 1 2 3 4 5 6 7 8 9/]->[rand 62] .
73     [qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z
74     a b c d e f g h i j k l m n o p q r s t u v w x y z
75     0 1 2 3 4 5 6 7 8 9/]->[rand 62] .
76     [qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z
77     a b c d e f g h i j k l m n o p q r s t u v w x y z
78     0 1 2 3 4 5 6 7 8 9/]->[rand 62]) .
79     (++$Message::Util::ManakaiNode::UniqueIDN)
80     )
81     ,
82     }, ref $self || $self;
83 wakaba 1.17
84    
85 wakaba 1.21 ;}
86 wakaba 1.19 $r}
87     sub _new_node ($$) {
88     my ($self, $className) = @_;
89     my $r;
90 wakaba 1.17
91     {
92    
93 wakaba 1.19
94     $r = bless {
95    
96     't'
97     => $className,
98    
99     'grc'
100    
101     => $self->{
102     'grc'
103     },
104    
105     'rc'
106     => 0,
107    
108     'tid'
109     => $self->{
110     'tid'
111     },
112    
113 wakaba 1.17 'nid'
114 wakaba 1.19 =>
115     (
116     'tag:suika.fam.cx,2005-09:' . time . ':' . $$ . ':' .
117     ($Message::Util::ManakaiNode::UniqueIDR ||=
118     [qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z
119     a b c d e f g h i j k l m n o p q r s t u v w x y z
120     0 1 2 3 4 5 6 7 8 9/]->[rand 62] .
121     [qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z
122     a b c d e f g h i j k l m n o p q r s t u v w x y z
123     0 1 2 3 4 5 6 7 8 9/]->[rand 62] .
124     [qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z
125     a b c d e f g h i j k l m n o p q r s t u v w x y z
126     0 1 2 3 4 5 6 7 8 9/]->[rand 62] .
127     [qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z
128     a b c d e f g h i j k l m n o p q r s t u v w x y z
129     0 1 2 3 4 5 6 7 8 9/]->[rand 62] .
130     [qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z
131     a b c d e f g h i j k l m n o p q r s t u v w x y z
132     0 1 2 3 4 5 6 7 8 9/]->[rand 62]) .
133     (++$Message::Util::ManakaiNode::UniqueIDN)
134 wakaba 1.1 )
135 wakaba 1.19 ,
136     }, ref $self;
137 wakaba 1.1
138    
139 wakaba 1.21 ;}
140 wakaba 1.19 $r}
141 wakaba 1.1 sub _is_externally_referred ($) {
142     my ($self) = @_;
143     my $r;
144    
145     {
146    
147     if
148     ($self->{
149     'rc'
150     }) {
151     $r =
152     1
153     ;
154     } else {
155     my @node = ($self);
156     my %checked;
157 wakaba 1.11 NODES: while (@node) {
158     my $node = shift @node;
159 wakaba 1.19 next NODES unless ref $node;
160 wakaba 1.1 if ($node->{
161     'rc'
162     }) {
163     $r =
164     1
165     ;
166     last NODES;
167     } elsif ($checked{$node->{
168 wakaba 1.4 'nid'
169 wakaba 1.1 }}) {
170     next NODES;
171     }
172     my @n;
173 wakaba 1.19 my $nt = $Message::Util::ManakaiNode::ManakaiNodeRef::Prop{
174     $node->{
175     't'
176     }
177     };
178     for my $p (@{$nt->{
179     's2'
180 wakaba 1.1 }}) {
181     if (ref $node->{$p} eq 'ARRAY') {
182     push @n, @{$node->{$p}};
183     } elsif (ref $node->{$p} eq 'HASH') {
184     push @n, values %{$node->{$p}};
185     }
186     }
187     for my $p (@n,
188 wakaba 1.19 map {$node->{$_}} @{$nt->{
189     's'
190 wakaba 1.1 }}) {
191     if (ref $p eq 'ARRAY') {
192     push @node, @$p;
193     } elsif (ref $p eq 'HASH') {
194     push @node, values %$p;
195     }
196     }
197 wakaba 1.19 for my $p (@{$nt->{
198     'o'
199 wakaba 1.1 }}) {
200     unshift @node, $node->{$p} if $node->{$p};
201     ## NOTE: Puts the top of the list,
202     ## since upper-level nodes are expected to be referred
203     ## more than lower-levels.
204     }
205 wakaba 1.19 for my $p (@{$nt->{
206     's0'
207 wakaba 1.1 }}) {
208     push @node, $node->{$p} if $node->{$p};
209     }
210     $checked{$node->{
211 wakaba 1.4 'nid'
212     }} =
213     1
214     ;
215 wakaba 1.1 }
216     }
217    
218    
219 wakaba 1.21 ;}
220 wakaba 1.17 $r}
221     sub _destroy ($) {
222     my ($self) = @_;
223 wakaba 1.1
224     {
225    
226 wakaba 1.11 my
227 wakaba 1.17 @node = ($self);
228 wakaba 1.18 my $tid = $self->{
229     'tid'
230     };
231     my %xrnode;
232 wakaba 1.17 NODES: while (@node) {
233     my $node = shift @node;
234     next NODES unless ref $node and defined $node->{
235     'nid'
236     };
237     my @n;
238     my $nt = $Message::Util::ManakaiNode::ManakaiNodeRef::Prop{
239     $node->{
240     't'
241     }
242     };
243     for my $p (@{$nt->{
244     's2'
245     }||[]}) {
246 wakaba 1.19 my $ref = ref $node->{$p};
247     if ($ref eq 'HASH') {
248     push @n, values %{$node->{$p}};
249     } elsif ($ref eq 'ARRAY') {
250 wakaba 1.17 push @n, @{$node->{$p}};
251     }
252     }
253 wakaba 1.19 for my $p (@n, map {$node->{$_}} @{$nt->{
254 wakaba 1.17 's'
255     }||[]}) {
256 wakaba 1.19 my $ref = ref $p;
257     if ($ref eq 'ARRAY') {
258 wakaba 1.17 push @node, @$p;
259 wakaba 1.19 } elsif ($ref eq 'HASH') {
260 wakaba 1.17 push @node, values %$p;
261     }
262     }
263     for my $p (@{$nt->{
264     'o'
265     }||[]},
266     @{$nt->{
267     's0'
268     }||[]}) {
269     push @node, $node->{$p};
270     }
271 wakaba 1.18
272     for my $p (@{$nt->{
273     'x'
274     }||[]}) {
275     if (defined $node->{$p} and
276     ${$node->{$p}->{
277     'tid'
278     }||$tid} ne $$tid) {
279     $node->{$p}->{
280     'rc'
281     }--;
282     ${$node->{$p}->{
283     'grc'
284     }}--;
285     $xrnode{${$node->{$p}->{
286     'tid'
287     }}} = $node->{$p};
288     }
289     }
290    
291 wakaba 1.17 %$node = ();
292 wakaba 1.18 } # @node
293    
294     CORE::delete $xrnode{$$tid};
295     for my $node (values %xrnode) {
296     unless (
297     (${$node->{'grc'}} > 0)
298     ) {
299     $node->
300     _destroy
301     ;
302     }
303 wakaba 1.17 }
304 wakaba 1.1
305    
306 wakaba 1.21 ;}
307 wakaba 1.1 }
308 wakaba 1.17 sub _import_tree ($$) {
309     my ($self, $node) = @_;
310 wakaba 1.1
311     {
312    
313 wakaba 1.17 my
314     @node = ($node);
315     my $newgrc = $self->{
316     'grc'
317     };
318     my $newtid = $self->{
319 wakaba 1.18 'tid'
320     };
321     my $oldtid = $node->{
322 wakaba 1.17 'tid'
323     };
324 wakaba 1.18 my @xrnode;
325 wakaba 1.17 NODES: while (@node) {
326     my $node = shift @node;
327     next NODES unless ref $node;
328     next NODES if ${$node->{
329     'tid'
330     }} eq $$newtid;
331     my @n;
332     my $nt = $Message::Util::ManakaiNode::ManakaiNodeRef::Prop{
333     $node->{
334     't'
335     }
336     };
337     for my $p (@{$nt->{
338     's2'
339     }||[]}) {
340 wakaba 1.19 my $ref = ref $node->{$p};
341     if ($ref eq 'HASH') {
342     push @n, values %{$node->{$p}};
343     } elsif ($ref eq 'ARRAY') {
344 wakaba 1.17 push @n, @{$node->{$p}};
345     }
346     }
347 wakaba 1.19 for my $p (@n, map {$node->{$_}} @{$nt->{
348 wakaba 1.17 's'
349     }||[]}) {
350 wakaba 1.19 my $ref = ref $p;
351     if ($ref eq 'ARRAY') {
352 wakaba 1.17 push @node, @$p;
353 wakaba 1.19 } elsif ($ref eq 'HASH') {
354 wakaba 1.17 push @node, values %$p;
355     }
356     }
357     for my $p (@{$nt->{
358     'o'
359     }||[]},
360     @{$nt->{
361     's0'
362     }||[]}) {
363 wakaba 1.19 push @node, $node->{$p} if defined $node->{$p};
364 wakaba 1.17 }
365    
366 wakaba 1.18 for (@{$nt->{
367     'x'
368     }||[]}) {
369     push @xrnode, $node->{$_} if defined $node->{$_};
370     }
371    
372 wakaba 1.17 ${$node->{
373     'grc'
374     }} -= $node->{
375     'rc'
376     };
377     $node->{
378     'tid'
379     } = $newtid;
380     $node->{
381     'grc'
382     } = $newgrc;
383 wakaba 1.19 $$newgrc += $node->{
384 wakaba 1.17 'rc'
385     };
386 wakaba 1.1 }
387    
388 wakaba 1.18 for my $n (@xrnode) {
389     if (${$n->{
390     'tid'
391     }} eq $$oldtid) {
392     $n->{
393     'rc'
394     }++;
395     ${$n->{
396     'grc'
397     }}++;
398     } elsif (${$n->{
399     'tid'
400     }} eq $$newtid) {
401     $n->{
402     'rc'
403     }--;
404     ${$n->{
405     'grc'
406     }}--;
407     ## Is it necessary to test whether rc is 0 or not
408     ## and if so call "destroy" method? Maybe it need not
409     ## (or should not, rather).
410     }
411     }
412    
413 wakaba 1.1
414 wakaba 1.21 ;}
415 wakaba 1.1 }
416 wakaba 1.19 sub _change_tree_id ($$$) {
417     my ($self, $treeID, $groveRC) = @_;
418 wakaba 1.1
419     {
420    
421 wakaba 1.19 my
422     $tid = ref $treeID ? $treeID : \$treeID;
423     my $oldtid = $self->{
424     'tid'
425     };
426     my @xrnode;
427     my @node = ($self);
428     NODES: while (@node) {
429     my $node = shift @node;
430     next NODES unless ref $node;
431     next NODES if ${$node->{
432     'tid'
433     }} eq $$tid;
434 wakaba 1.1 my @n;
435 wakaba 1.8 my $nt = $Message::Util::ManakaiNode::ManakaiNodeRef::Prop{
436     $node->{
437     't'
438     }
439     };
440     for my $p (@{$nt->{
441     's2'
442 wakaba 1.19 }||[]}) {
443 wakaba 1.1 if (ref $node->{$p} eq 'ARRAY') {
444     push @n, @{$node->{$p}};
445     } elsif (ref $node->{$p} eq 'HASH') {
446     push @n, values %{$node->{$p}};
447     }
448     }
449     for my $p (@n,
450 wakaba 1.8 map {$node->{$_}} @{$nt->{
451     's'
452 wakaba 1.19 }||[]}) {
453 wakaba 1.1 if (ref $p eq 'ARRAY') {
454     push @node, @$p;
455     } elsif (ref $p eq 'HASH') {
456     push @node, values %$p;
457     }
458     }
459 wakaba 1.19 for my $p (@{$nt->{
460 wakaba 1.8 'o'
461 wakaba 1.19 }||[]},
462     @{$nt->{
463 wakaba 1.8 's0'
464 wakaba 1.19 }||[]}) {
465     push @node, $node->{$p};
466     }
467    
468     for (@{$nt->{
469     'x'
470     }||[]}) {
471     push @xrnode, $node->{$_} if defined $node->{$_};
472     }
473    
474     ${$node->{
475     'grc'
476     }} -= $node->{
477     'rc'
478     };
479     $node->{
480     'tid'
481     } = $tid;
482     $node->{
483     'grc'
484     } = $groveRC;
485     ${$node->{
486     'grc'
487     }} += $node->{
488     'rc'
489     };
490     }
491    
492     for my $n (@xrnode) {
493     if (${$n->{
494     'tid'
495     }} eq $$oldtid) {
496     $n->{
497     'rc'
498     }++;
499     ${$n->{
500     'grc'
501     }}++;
502     } elsif (${$n->{
503     'tid'
504     }} eq $$tid) {
505     $n->{
506     'rc'
507     }--;
508     ${$n->{
509     'grc'
510     }}--;
511     ## Is it necessary to test whether rc is 0 or not
512     ## and if so call "destroy" method? Maybe it need not
513     ## (or should not, rather).
514 wakaba 1.1 }
515     }
516    
517    
518 wakaba 1.21 ;}
519 wakaba 1.1 }
520     sub _is_same_node ($$) {
521     my ($self, $node) = @_;
522     my $r;
523    
524     {
525    
526     if
527     (ref $node and
528     UNIVERSAL::isa ($node,
529 wakaba 1.8 'Message::Util::ManakaiNode::ManakaiNodeStem'
530 wakaba 1.1 ) and
531     $node->{
532 wakaba 1.4 'nid'
533 wakaba 1.1 } eq $self->{
534 wakaba 1.4 'nid'
535 wakaba 1.1 }) {
536     $r =
537     1
538     ;
539     }
540 wakaba 1.11
541 wakaba 1.17
542 wakaba 1.21 ;}
543 wakaba 1.17 $r}
544     sub _orphanate ($) {
545     my ($self) = @_;
546    
547     {
548    
549     if
550     ($self->
551     _is_externally_referred
552     ) {
553     my $grc = 0;
554     $self->
555     _change_tree_id
556    
557     (\(
558     (
559 wakaba 1.19 'tag:suika.fam.cx,2005-09:' . time . ':' . $$ . ':' .
560     ($Message::Util::ManakaiNode::UniqueIDR ||=
561     [qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z
562     a b c d e f g h i j k l m n o p q r s t u v w x y z
563     0 1 2 3 4 5 6 7 8 9/]->[rand 62] .
564     [qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z
565     a b c d e f g h i j k l m n o p q r s t u v w x y z
566     0 1 2 3 4 5 6 7 8 9/]->[rand 62] .
567     [qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z
568     a b c d e f g h i j k l m n o p q r s t u v w x y z
569     0 1 2 3 4 5 6 7 8 9/]->[rand 62] .
570     [qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z
571     a b c d e f g h i j k l m n o p q r s t u v w x y z
572     0 1 2 3 4 5 6 7 8 9/]->[rand 62] .
573     [qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z
574     a b c d e f g h i j k l m n o p q r s t u v w x y z
575     0 1 2 3 4 5 6 7 8 9/]->[rand 62]) .
576     (++$Message::Util::ManakaiNode::UniqueIDN)
577 wakaba 1.17 )
578     ), \$grc);
579     } else {
580     $self->
581     _destroy
582     ;
583 wakaba 1.1 }
584    
585    
586 wakaba 1.21 ;}
587 wakaba 1.1 }
588 wakaba 1.19 use overload
589     bool => sub () {1},
590     'eq' => '_is_same_node',
591     fallback => 1;
592 wakaba 1.1 $Message::DOM::ClassFeature{q<Message::Util::ManakaiNode::ManakaiNodeStem>} = {};
593     $Message::DOM::ClassPoint{q<Message::Util::ManakaiNode::ManakaiNodeStem>} = 0;
594 wakaba 1.19 package Message::Util::ManakaiNode::ManakaiNodeRef;
595 wakaba 1.21 our $VERSION = 20051120.0927;
596 wakaba 1.1 push our @ISA, 'Message::Util::IF::NodeRef';
597 wakaba 1.19 sub free ($) {
598 wakaba 1.1 my ($self) = @_;
599    
600     {
601    
602 wakaba 1.19
603     $self->{
604 wakaba 1.1 'node'
605 wakaba 1.19 }->
606 wakaba 1.1 _destroy
607     ;
608    
609    
610 wakaba 1.21 ;}
611 wakaba 1.1 }
612 wakaba 1.19 sub DESTROY ($) {
613 wakaba 1.1 my ($self) = @_;
614    
615     {
616    
617 wakaba 1.19 if
618     (my $node = $self->{
619 wakaba 1.1 'node'
620 wakaba 1.19 }) {
621 wakaba 1.1 CORE::delete $self->{
622     'node'
623     };
624     unless ($self->{
625 wakaba 1.4 'w'
626 wakaba 1.1 }) {
627     $node->{
628     'rc'
629     }--;
630 wakaba 1.11 ${$node->{
631     'grc'
632     }}--;
633     unless (
634     (${$node->{'grc'}} > 0)
635 wakaba 1.1 ) {
636     $node->
637     _destroy
638     ;
639     }
640     }
641     } else {
642     warn ref ($self) . q{->DESTROY: there is no associated }.
643     q{node object - you have a global variable or }.
644     qq{potential memory-leak detected\n};
645     }
646    
647    
648 wakaba 1.21 ;}
649 wakaba 1.1 }
650 wakaba 1.19 *_destroy = \&DESTROY;
651 wakaba 1.1 $Message::DOM::ClassFeature{q<Message::Util::ManakaiNode::ManakaiNodeRef>} = {};
652     $Message::DOM::ClassPoint{q<Message::Util::ManakaiNode::ManakaiNodeRef>} = 0;
653 wakaba 1.7 $Message::Util::ManakaiNode::ManakaiNodeRef::Prop{q<Message::Util::ManakaiNode::ManakaiNodeRef>} = {};
654 wakaba 1.16 package Message::Util::IF::NodeRef;
655 wakaba 1.21 our $VERSION = 20051120.0927;
656 wakaba 1.1 ## License: <http://suika.fam.cx/~wakaba/archive/2004/8/18/license#Perl+MPL>
657     1;

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24