1 |
wakaba |
1.1 |
#!/usr/bin/perl |
2 |
|
|
## This file is automatically generated |
3 |
wakaba |
1.23 |
## at 2005-11-23T08:20:06+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.23 |
our $VERSION = 20051123.0820; |
11 |
wakaba |
1.19 |
package Message::Util::IF::NodeStem; |
12 |
wakaba |
1.23 |
our $VERSION = 20051123.0820; |
13 |
wakaba |
1.19 |
package Message::Util::ManakaiNode::ManakaiNodeStem; |
14 |
wakaba |
1.23 |
our $VERSION = 20051123.0820; |
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 |
wakaba |
1.22 |
$node-> |
273 |
|
|
_destroy_node_stem |
274 |
|
|
; |
275 |
|
|
|
276 |
wakaba |
1.18 |
for my $p (@{$nt->{ |
277 |
|
|
'x' |
278 |
|
|
}||[]}) { |
279 |
|
|
if (defined $node->{$p} and |
280 |
|
|
${$node->{$p}->{ |
281 |
|
|
'tid' |
282 |
|
|
}||$tid} ne $$tid) { |
283 |
|
|
$node->{$p}->{ |
284 |
|
|
'rc' |
285 |
|
|
}--; |
286 |
|
|
${$node->{$p}->{ |
287 |
|
|
'grc' |
288 |
|
|
}}--; |
289 |
|
|
$xrnode{${$node->{$p}->{ |
290 |
|
|
'tid' |
291 |
|
|
}}} = $node->{$p}; |
292 |
|
|
} |
293 |
|
|
} |
294 |
|
|
|
295 |
wakaba |
1.17 |
%$node = (); |
296 |
wakaba |
1.18 |
} # @node |
297 |
|
|
|
298 |
|
|
CORE::delete $xrnode{$$tid}; |
299 |
|
|
for my $node (values %xrnode) { |
300 |
|
|
unless ( |
301 |
|
|
(${$node->{'grc'}} > 0) |
302 |
|
|
) { |
303 |
|
|
$node-> |
304 |
|
|
_destroy |
305 |
|
|
; |
306 |
|
|
} |
307 |
wakaba |
1.17 |
} |
308 |
wakaba |
1.1 |
|
309 |
|
|
|
310 |
wakaba |
1.21 |
;} |
311 |
wakaba |
1.1 |
} |
312 |
wakaba |
1.22 |
sub _destroy_node_stem ($) { |
313 |
|
|
my ($self) = @_; |
314 |
|
|
|
315 |
|
|
{ |
316 |
|
|
|
317 |
|
|
|
318 |
|
|
## No action by default |
319 |
|
|
|
320 |
|
|
|
321 |
|
|
;} |
322 |
|
|
} |
323 |
wakaba |
1.17 |
sub _import_tree ($$) { |
324 |
|
|
my ($self, $node) = @_; |
325 |
wakaba |
1.1 |
|
326 |
|
|
{ |
327 |
|
|
|
328 |
wakaba |
1.17 |
my |
329 |
|
|
@node = ($node); |
330 |
|
|
my $newgrc = $self->{ |
331 |
|
|
'grc' |
332 |
|
|
}; |
333 |
|
|
my $newtid = $self->{ |
334 |
wakaba |
1.18 |
'tid' |
335 |
|
|
}; |
336 |
|
|
my $oldtid = $node->{ |
337 |
wakaba |
1.17 |
'tid' |
338 |
|
|
}; |
339 |
wakaba |
1.18 |
my @xrnode; |
340 |
wakaba |
1.17 |
NODES: while (@node) { |
341 |
|
|
my $node = shift @node; |
342 |
|
|
next NODES unless ref $node; |
343 |
|
|
next NODES if ${$node->{ |
344 |
|
|
'tid' |
345 |
|
|
}} eq $$newtid; |
346 |
|
|
my @n; |
347 |
|
|
my $nt = $Message::Util::ManakaiNode::ManakaiNodeRef::Prop{ |
348 |
|
|
$node->{ |
349 |
|
|
't' |
350 |
|
|
} |
351 |
|
|
}; |
352 |
|
|
for my $p (@{$nt->{ |
353 |
|
|
's2' |
354 |
|
|
}||[]}) { |
355 |
wakaba |
1.19 |
my $ref = ref $node->{$p}; |
356 |
|
|
if ($ref eq 'HASH') { |
357 |
|
|
push @n, values %{$node->{$p}}; |
358 |
|
|
} elsif ($ref eq 'ARRAY') { |
359 |
wakaba |
1.17 |
push @n, @{$node->{$p}}; |
360 |
|
|
} |
361 |
|
|
} |
362 |
wakaba |
1.19 |
for my $p (@n, map {$node->{$_}} @{$nt->{ |
363 |
wakaba |
1.17 |
's' |
364 |
|
|
}||[]}) { |
365 |
wakaba |
1.19 |
my $ref = ref $p; |
366 |
|
|
if ($ref eq 'ARRAY') { |
367 |
wakaba |
1.17 |
push @node, @$p; |
368 |
wakaba |
1.19 |
} elsif ($ref eq 'HASH') { |
369 |
wakaba |
1.17 |
push @node, values %$p; |
370 |
|
|
} |
371 |
|
|
} |
372 |
|
|
for my $p (@{$nt->{ |
373 |
|
|
'o' |
374 |
|
|
}||[]}, |
375 |
|
|
@{$nt->{ |
376 |
|
|
's0' |
377 |
|
|
}||[]}) { |
378 |
wakaba |
1.19 |
push @node, $node->{$p} if defined $node->{$p}; |
379 |
wakaba |
1.17 |
} |
380 |
|
|
|
381 |
wakaba |
1.18 |
for (@{$nt->{ |
382 |
|
|
'x' |
383 |
|
|
}||[]}) { |
384 |
|
|
push @xrnode, $node->{$_} if defined $node->{$_}; |
385 |
|
|
} |
386 |
|
|
|
387 |
wakaba |
1.17 |
${$node->{ |
388 |
|
|
'grc' |
389 |
|
|
}} -= $node->{ |
390 |
|
|
'rc' |
391 |
|
|
}; |
392 |
|
|
$node->{ |
393 |
|
|
'tid' |
394 |
|
|
} = $newtid; |
395 |
|
|
$node->{ |
396 |
|
|
'grc' |
397 |
|
|
} = $newgrc; |
398 |
wakaba |
1.19 |
$$newgrc += $node->{ |
399 |
wakaba |
1.17 |
'rc' |
400 |
|
|
}; |
401 |
wakaba |
1.1 |
} |
402 |
|
|
|
403 |
wakaba |
1.18 |
for my $n (@xrnode) { |
404 |
|
|
if (${$n->{ |
405 |
|
|
'tid' |
406 |
|
|
}} eq $$oldtid) { |
407 |
|
|
$n->{ |
408 |
|
|
'rc' |
409 |
|
|
}++; |
410 |
|
|
${$n->{ |
411 |
|
|
'grc' |
412 |
|
|
}}++; |
413 |
|
|
} elsif (${$n->{ |
414 |
|
|
'tid' |
415 |
|
|
}} eq $$newtid) { |
416 |
|
|
$n->{ |
417 |
|
|
'rc' |
418 |
|
|
}--; |
419 |
|
|
${$n->{ |
420 |
|
|
'grc' |
421 |
|
|
}}--; |
422 |
|
|
## Is it necessary to test whether rc is 0 or not |
423 |
|
|
## and if so call "destroy" method? Maybe it need not |
424 |
|
|
## (or should not, rather). |
425 |
|
|
} |
426 |
|
|
} |
427 |
|
|
|
428 |
wakaba |
1.1 |
|
429 |
wakaba |
1.21 |
;} |
430 |
wakaba |
1.1 |
} |
431 |
wakaba |
1.19 |
sub _change_tree_id ($$$) { |
432 |
|
|
my ($self, $treeID, $groveRC) = @_; |
433 |
wakaba |
1.1 |
|
434 |
|
|
{ |
435 |
|
|
|
436 |
wakaba |
1.19 |
my |
437 |
|
|
$tid = ref $treeID ? $treeID : \$treeID; |
438 |
|
|
my $oldtid = $self->{ |
439 |
|
|
'tid' |
440 |
|
|
}; |
441 |
|
|
my @xrnode; |
442 |
|
|
my @node = ($self); |
443 |
|
|
NODES: while (@node) { |
444 |
|
|
my $node = shift @node; |
445 |
|
|
next NODES unless ref $node; |
446 |
|
|
next NODES if ${$node->{ |
447 |
|
|
'tid' |
448 |
|
|
}} eq $$tid; |
449 |
wakaba |
1.1 |
my @n; |
450 |
wakaba |
1.8 |
my $nt = $Message::Util::ManakaiNode::ManakaiNodeRef::Prop{ |
451 |
|
|
$node->{ |
452 |
|
|
't' |
453 |
|
|
} |
454 |
|
|
}; |
455 |
|
|
for my $p (@{$nt->{ |
456 |
|
|
's2' |
457 |
wakaba |
1.19 |
}||[]}) { |
458 |
wakaba |
1.1 |
if (ref $node->{$p} eq 'ARRAY') { |
459 |
|
|
push @n, @{$node->{$p}}; |
460 |
|
|
} elsif (ref $node->{$p} eq 'HASH') { |
461 |
|
|
push @n, values %{$node->{$p}}; |
462 |
|
|
} |
463 |
|
|
} |
464 |
|
|
for my $p (@n, |
465 |
wakaba |
1.8 |
map {$node->{$_}} @{$nt->{ |
466 |
|
|
's' |
467 |
wakaba |
1.19 |
}||[]}) { |
468 |
wakaba |
1.1 |
if (ref $p eq 'ARRAY') { |
469 |
|
|
push @node, @$p; |
470 |
|
|
} elsif (ref $p eq 'HASH') { |
471 |
|
|
push @node, values %$p; |
472 |
|
|
} |
473 |
|
|
} |
474 |
wakaba |
1.19 |
for my $p (@{$nt->{ |
475 |
wakaba |
1.8 |
'o' |
476 |
wakaba |
1.19 |
}||[]}, |
477 |
|
|
@{$nt->{ |
478 |
wakaba |
1.8 |
's0' |
479 |
wakaba |
1.19 |
}||[]}) { |
480 |
|
|
push @node, $node->{$p}; |
481 |
|
|
} |
482 |
|
|
|
483 |
|
|
for (@{$nt->{ |
484 |
|
|
'x' |
485 |
|
|
}||[]}) { |
486 |
|
|
push @xrnode, $node->{$_} if defined $node->{$_}; |
487 |
|
|
} |
488 |
|
|
|
489 |
|
|
${$node->{ |
490 |
|
|
'grc' |
491 |
|
|
}} -= $node->{ |
492 |
|
|
'rc' |
493 |
|
|
}; |
494 |
|
|
$node->{ |
495 |
|
|
'tid' |
496 |
|
|
} = $tid; |
497 |
|
|
$node->{ |
498 |
|
|
'grc' |
499 |
|
|
} = $groveRC; |
500 |
|
|
${$node->{ |
501 |
|
|
'grc' |
502 |
|
|
}} += $node->{ |
503 |
|
|
'rc' |
504 |
|
|
}; |
505 |
|
|
} |
506 |
|
|
|
507 |
|
|
for my $n (@xrnode) { |
508 |
|
|
if (${$n->{ |
509 |
|
|
'tid' |
510 |
|
|
}} eq $$oldtid) { |
511 |
|
|
$n->{ |
512 |
|
|
'rc' |
513 |
|
|
}++; |
514 |
|
|
${$n->{ |
515 |
|
|
'grc' |
516 |
|
|
}}++; |
517 |
|
|
} elsif (${$n->{ |
518 |
|
|
'tid' |
519 |
|
|
}} eq $$tid) { |
520 |
|
|
$n->{ |
521 |
|
|
'rc' |
522 |
|
|
}--; |
523 |
|
|
${$n->{ |
524 |
|
|
'grc' |
525 |
|
|
}}--; |
526 |
|
|
## Is it necessary to test whether rc is 0 or not |
527 |
|
|
## and if so call "destroy" method? Maybe it need not |
528 |
|
|
## (or should not, rather). |
529 |
wakaba |
1.1 |
} |
530 |
|
|
} |
531 |
|
|
|
532 |
|
|
|
533 |
wakaba |
1.21 |
;} |
534 |
wakaba |
1.1 |
} |
535 |
|
|
sub _is_same_node ($$) { |
536 |
|
|
my ($self, $node) = @_; |
537 |
|
|
my $r; |
538 |
|
|
|
539 |
|
|
{ |
540 |
|
|
|
541 |
|
|
if |
542 |
|
|
(ref $node and |
543 |
|
|
UNIVERSAL::isa ($node, |
544 |
wakaba |
1.8 |
'Message::Util::ManakaiNode::ManakaiNodeStem' |
545 |
wakaba |
1.1 |
) and |
546 |
|
|
$node->{ |
547 |
wakaba |
1.4 |
'nid' |
548 |
wakaba |
1.1 |
} eq $self->{ |
549 |
wakaba |
1.4 |
'nid' |
550 |
wakaba |
1.1 |
}) { |
551 |
|
|
$r = |
552 |
|
|
1 |
553 |
|
|
; |
554 |
|
|
} |
555 |
wakaba |
1.11 |
|
556 |
wakaba |
1.17 |
|
557 |
wakaba |
1.21 |
;} |
558 |
wakaba |
1.17 |
$r} |
559 |
|
|
sub _orphanate ($) { |
560 |
|
|
my ($self) = @_; |
561 |
|
|
|
562 |
|
|
{ |
563 |
|
|
|
564 |
|
|
if |
565 |
|
|
($self-> |
566 |
|
|
_is_externally_referred |
567 |
|
|
) { |
568 |
|
|
my $grc = 0; |
569 |
|
|
$self-> |
570 |
|
|
_change_tree_id |
571 |
|
|
|
572 |
|
|
(\( |
573 |
|
|
( |
574 |
wakaba |
1.19 |
'tag:suika.fam.cx,2005-09:' . time . ':' . $$ . ':' . |
575 |
|
|
($Message::Util::ManakaiNode::UniqueIDR ||= |
576 |
|
|
[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 |
577 |
|
|
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 |
578 |
|
|
0 1 2 3 4 5 6 7 8 9/]->[rand 62] . |
579 |
|
|
[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 |
580 |
|
|
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 |
581 |
|
|
0 1 2 3 4 5 6 7 8 9/]->[rand 62] . |
582 |
|
|
[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 |
583 |
|
|
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 |
584 |
|
|
0 1 2 3 4 5 6 7 8 9/]->[rand 62] . |
585 |
|
|
[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 |
586 |
|
|
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 |
587 |
|
|
0 1 2 3 4 5 6 7 8 9/]->[rand 62] . |
588 |
|
|
[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 |
589 |
|
|
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 |
590 |
|
|
0 1 2 3 4 5 6 7 8 9/]->[rand 62]) . |
591 |
|
|
(++$Message::Util::ManakaiNode::UniqueIDN) |
592 |
wakaba |
1.17 |
) |
593 |
|
|
), \$grc); |
594 |
|
|
} else { |
595 |
|
|
$self-> |
596 |
|
|
_destroy |
597 |
|
|
; |
598 |
wakaba |
1.1 |
} |
599 |
|
|
|
600 |
|
|
|
601 |
wakaba |
1.21 |
;} |
602 |
wakaba |
1.1 |
} |
603 |
wakaba |
1.19 |
use overload |
604 |
|
|
bool => sub () {1}, |
605 |
|
|
'eq' => '_is_same_node', |
606 |
|
|
fallback => 1; |
607 |
wakaba |
1.1 |
$Message::DOM::ClassFeature{q<Message::Util::ManakaiNode::ManakaiNodeStem>} = {}; |
608 |
|
|
$Message::DOM::ClassPoint{q<Message::Util::ManakaiNode::ManakaiNodeStem>} = 0; |
609 |
wakaba |
1.19 |
package Message::Util::ManakaiNode::ManakaiNodeRef; |
610 |
wakaba |
1.23 |
our $VERSION = 20051123.0820; |
611 |
wakaba |
1.1 |
push our @ISA, 'Message::Util::IF::NodeRef'; |
612 |
wakaba |
1.19 |
sub free ($) { |
613 |
wakaba |
1.1 |
my ($self) = @_; |
614 |
|
|
|
615 |
|
|
{ |
616 |
|
|
|
617 |
wakaba |
1.19 |
|
618 |
|
|
$self->{ |
619 |
wakaba |
1.1 |
'node' |
620 |
wakaba |
1.19 |
}-> |
621 |
wakaba |
1.1 |
_destroy |
622 |
|
|
; |
623 |
|
|
|
624 |
|
|
|
625 |
wakaba |
1.21 |
;} |
626 |
wakaba |
1.1 |
} |
627 |
wakaba |
1.19 |
sub DESTROY ($) { |
628 |
wakaba |
1.1 |
my ($self) = @_; |
629 |
|
|
|
630 |
|
|
{ |
631 |
|
|
|
632 |
wakaba |
1.19 |
if |
633 |
|
|
(my $node = $self->{ |
634 |
wakaba |
1.1 |
'node' |
635 |
wakaba |
1.19 |
}) { |
636 |
wakaba |
1.1 |
CORE::delete $self->{ |
637 |
|
|
'node' |
638 |
|
|
}; |
639 |
|
|
unless ($self->{ |
640 |
wakaba |
1.4 |
'w' |
641 |
wakaba |
1.1 |
}) { |
642 |
|
|
$node->{ |
643 |
|
|
'rc' |
644 |
|
|
}--; |
645 |
wakaba |
1.11 |
${$node->{ |
646 |
|
|
'grc' |
647 |
|
|
}}--; |
648 |
|
|
unless ( |
649 |
|
|
(${$node->{'grc'}} > 0) |
650 |
wakaba |
1.1 |
) { |
651 |
|
|
$node-> |
652 |
|
|
_destroy |
653 |
|
|
; |
654 |
|
|
} |
655 |
|
|
} |
656 |
|
|
} else { |
657 |
|
|
warn ref ($self) . q{->DESTROY: there is no associated }. |
658 |
|
|
q{node object - you have a global variable or }. |
659 |
|
|
qq{potential memory-leak detected\n}; |
660 |
|
|
} |
661 |
|
|
|
662 |
|
|
|
663 |
wakaba |
1.21 |
;} |
664 |
wakaba |
1.1 |
} |
665 |
wakaba |
1.19 |
*_destroy = \&DESTROY; |
666 |
wakaba |
1.1 |
$Message::DOM::ClassFeature{q<Message::Util::ManakaiNode::ManakaiNodeRef>} = {}; |
667 |
|
|
$Message::DOM::ClassPoint{q<Message::Util::ManakaiNode::ManakaiNodeRef>} = 0; |
668 |
wakaba |
1.7 |
$Message::Util::ManakaiNode::ManakaiNodeRef::Prop{q<Message::Util::ManakaiNode::ManakaiNodeRef>} = {}; |
669 |
wakaba |
1.16 |
package Message::Util::IF::NodeRef; |
670 |
wakaba |
1.23 |
our $VERSION = 20051123.0820; |
671 |
wakaba |
1.1 |
## License: <http://suika.fam.cx/~wakaba/archive/2004/8/18/license#Perl+MPL> |
672 |
|
|
1; |