Message/Util/ManakaiNode.pm

#!/usr/bin/perl 
## This file is automatically generated
##      at 2005-11-23T08:20:06+00:00,
##      from file "lib/Message/Util/ManakaiNode.dis",
##      module <http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/ManakaiNode>,
##      for <http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#Perl>.
## Don't edit by hand!
use strict;
package Message::Util::ManakaiNode;
our $VERSION = 20051123.0820;
package Message::Util::IF::NodeStem;
our $VERSION = 20051123.0820;
package Message::Util::ManakaiNode::ManakaiNodeStem;
our $VERSION = 20051123.0820;
push our @ISA, 'Message::Util::IF::NodeStem';
sub _new ($$) {
my ($self, $className) = @_;
my $r;

{

my 
$grc = 0;
$r = bless {
  
't'
   => $className,
  
'grc'
 => \$grc,
  
'rc'
     => 0,
  
'tid'
 => \ (
(
  'tag:suika.fam.cx,2005-09:' . time . ':' . $$ . ':' .
  ($Message::Util::ManakaiNode::UniqueIDR ||=
    [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
        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
        0 1 2 3 4 5 6 7 8 9/]->[rand 62] .
    [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
        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
        0 1 2 3 4 5 6 7 8 9/]->[rand 62] .
    [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
        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
        0 1 2 3 4 5 6 7 8 9/]->[rand 62] .
    [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
        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
        0 1 2 3 4 5 6 7 8 9/]->[rand 62] .
    [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
        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
        0 1 2 3 4 5 6 7 8 9/]->[rand 62]) .
  (++$Message::Util::ManakaiNode::UniqueIDN)
)
),
  
'nid'
 => 
(
  'tag:suika.fam.cx,2005-09:' . time . ':' . $$ . ':' .
  ($Message::Util::ManakaiNode::UniqueIDR ||=
    [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
        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
        0 1 2 3 4 5 6 7 8 9/]->[rand 62] .
    [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
        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
        0 1 2 3 4 5 6 7 8 9/]->[rand 62] .
    [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
        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
        0 1 2 3 4 5 6 7 8 9/]->[rand 62] .
    [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
        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
        0 1 2 3 4 5 6 7 8 9/]->[rand 62] .
    [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
        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
        0 1 2 3 4 5 6 7 8 9/]->[rand 62]) .
  (++$Message::Util::ManakaiNode::UniqueIDN)
)
,
}, ref $self || $self;


;}
$r}
sub _new_node ($$) {
my ($self, $className) = @_;
my $r;

{


$r = bless {
  
't'
   => $className,
  
'grc'

                 => $self->{
'grc'
},
  
'rc'
     => 0,
  
'tid'
 => $self->{
'tid'
},
  
'nid'
 => 
(
  'tag:suika.fam.cx,2005-09:' . time . ':' . $$ . ':' .
  ($Message::Util::ManakaiNode::UniqueIDR ||=
    [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
        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
        0 1 2 3 4 5 6 7 8 9/]->[rand 62] .
    [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
        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
        0 1 2 3 4 5 6 7 8 9/]->[rand 62] .
    [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
        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
        0 1 2 3 4 5 6 7 8 9/]->[rand 62] .
    [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
        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
        0 1 2 3 4 5 6 7 8 9/]->[rand 62] .
    [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
        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
        0 1 2 3 4 5 6 7 8 9/]->[rand 62]) .
  (++$Message::Util::ManakaiNode::UniqueIDN)
)
,
}, ref $self;


;}
$r}
sub _is_externally_referred ($) {
my ($self) = @_;
my $r;

{

if 
($self->{
'rc'
}) {
  $r = 
1
;
} else {
  my @node = ($self);
  my %checked;
  NODES: while (@node) {
    my $node = shift @node;
    next NODES unless ref $node;
    if ($node->{
'rc'
}) {
      $r = 
1
;
      last NODES;
    } elsif ($checked{$node->{
'nid'
}}) {
      next NODES;
    }
    my @n;
    my $nt = $Message::Util::ManakaiNode::ManakaiNodeRef::Prop{
      $node->{
't'
}
    }; 
    for my $p (@{$nt->{
's2'
}}) {
      if (ref $node->{$p} eq 'ARRAY') {
        push @n, @{$node->{$p}};
      } elsif (ref $node->{$p} eq 'HASH') {
        push @n, values %{$node->{$p}};
      }
    }
    for my $p (@n,
               map {$node->{$_}} @{$nt->{
's'
}}) {
      if (ref $p eq 'ARRAY') {
        push @node, @$p;
      } elsif (ref $p eq 'HASH') {
        push @node, values %$p;
      }
    }
    for my $p (@{$nt->{
'o'
}}) {
      unshift @node, $node->{$p} if $node->{$p};
      ## NOTE: Puts the top of the list,
      ##       since upper-level nodes are expected to be referred
      ##       more than lower-levels.
    }
    for my $p (@{$nt->{
's0'
}}) {
      push @node, $node->{$p} if $node->{$p};
    }
    $checked{$node->{
'nid'
}} = 
1
;
  }
}


;}
$r}
sub _destroy ($) {
my ($self) = @_;

{

my 
@node = ($self);
my $tid = $self->{
'tid'
};
my %xrnode;
NODES: while (@node) {
  my $node = shift @node;
  next NODES unless ref $node and defined $node->{
'nid'
};
  my @n;
      my $nt = $Message::Util::ManakaiNode::ManakaiNodeRef::Prop{
        $node->{
't'
}
      }; 
      for my $p (@{$nt->{
's2'
}||[]}) {
        my $ref = ref $node->{$p};
        if ($ref eq 'HASH') {
          push @n, values %{$node->{$p}};
        } elsif ($ref eq 'ARRAY') {
          push @n, @{$node->{$p}};
        }
      }
      for my $p (@n, map {$node->{$_}} @{$nt->{
's'
}||[]}) {
        my $ref = ref $p;
        if ($ref eq 'ARRAY') {
          push @node, @$p;
        } elsif ($ref eq 'HASH') {
          push @node, values %$p;
        }
      }
      for my $p (@{$nt->{
'o'
}||[]},
             @{$nt->{
's0'
}||[]}) {
        push @node, $node->{$p};
      }

  $node->
_destroy_node_stem
;

  for my $p (@{$nt->{
'x'
}||[]}) {
    if (defined $node->{$p} and 
        ${$node->{$p}->{
'tid'
}||$tid} ne $$tid) {
      $node->{$p}->{
'rc'
}--;
      ${$node->{$p}->{
'grc'
}}--;
      $xrnode{${$node->{$p}->{
'tid'
}}} = $node->{$p};
    }
  }

  %$node = ();
} # @node

CORE::delete $xrnode{$$tid};
for my $node (values %xrnode) {
  unless (
(${$node->{'grc'}} > 0)
) {
    $node->
_destroy
;
  }
}


;}
}
sub _destroy_node_stem ($) {
my ($self) = @_;

{


## No action by default


;}
}
sub _import_tree ($$) {
my ($self, $node) = @_;

{

my 
@node = ($node);
my $newgrc = $self->{
'grc'
};
my $newtid = $self->{
'tid'
};
my $oldtid = $node->{
'tid'
};
my @xrnode;
NODES: while (@node) {
  my $node = shift @node;
  next NODES unless ref $node;
  next NODES if ${$node->{
'tid'
}} eq $$newtid;
  my @n;
    my $nt = $Message::Util::ManakaiNode::ManakaiNodeRef::Prop{
      $node->{
't'
}
    }; 
    for my $p (@{$nt->{
's2'
}||[]}) {
      my $ref = ref $node->{$p};
      if ($ref eq 'HASH') {
        push @n, values %{$node->{$p}};
      } elsif ($ref eq 'ARRAY') {
        push @n, @{$node->{$p}};
      }
    }
    for my $p (@n, map {$node->{$_}} @{$nt->{
's'
}||[]}) {
      my $ref = ref $p;
      if ($ref eq 'ARRAY') {
        push @node, @$p;
      } elsif ($ref eq 'HASH') {
        push @node, values %$p;
      }
    }
  for my $p (@{$nt->{
'o'
}||[]},
           @{$nt->{
's0'
}||[]}) {
    push @node, $node->{$p} if defined $node->{$p};
  }

  for (@{$nt->{
'x'
}||[]}) {
    push @xrnode, $node->{$_} if defined $node->{$_};
  }

  ${$node->{
'grc'
}} -= $node->{
'rc'
};
  $node->{
'tid'
} = $newtid;
  $node->{
'grc'
} = $newgrc;
  $$newgrc += $node->{
'rc'
};
}

for my $n (@xrnode) {
  if (${$n->{
'tid'
}} eq $$oldtid) {
    $n->{
'rc'
}++;
    ${$n->{
'grc'
}}++;
  } elsif (${$n->{
'tid'
}} eq $$newtid) {
    $n->{
'rc'
}--;
    ${$n->{
'grc'
}}--;
    ## Is it necessary to test whether rc is 0 or not
    ## and if so call "destroy" method?  Maybe it need not
    ## (or should not, rather).
  }
}


;}
}
sub _change_tree_id ($$$) {
my ($self, $treeID, $groveRC) = @_;

{

my 
$tid = ref $treeID ? $treeID : \$treeID;
my $oldtid = $self->{
'tid'
};
my @xrnode;
my @node = ($self);
NODES: while (@node) {
  my $node = shift @node;
  next NODES unless ref $node;
  next NODES if ${$node->{
'tid'
}} eq $$tid;
    my @n;
    my $nt = $Message::Util::ManakaiNode::ManakaiNodeRef::Prop{
      $node->{
't'
}
    }; 
    for my $p (@{$nt->{
's2'
}||[]}) {
      if (ref $node->{$p} eq 'ARRAY') {
        push @n, @{$node->{$p}};
      } elsif (ref $node->{$p} eq 'HASH') {
        push @n, values %{$node->{$p}};
      }
    }
    for my $p (@n,
               map {$node->{$_}} @{$nt->{
's'
}||[]}) {
      if (ref $p eq 'ARRAY') {
        push @node, @$p;
      } elsif (ref $p eq 'HASH') {
        push @node, values %$p;
      }
    }
  for my $p (@{$nt->{
'o'
}||[]},
               @{$nt->{
's0'
}||[]}) {
    push @node, $node->{$p};
  }

  for (@{$nt->{
'x'
}||[]}) {
    push @xrnode, $node->{$_} if defined $node->{$_};
  }

  ${$node->{
'grc'
}} -= $node->{
'rc'
};
  $node->{
'tid'
} = $tid;
  $node->{
'grc'
} = $groveRC;
  ${$node->{
'grc'
}} += $node->{
'rc'
};
}

for my $n (@xrnode) {
  if (${$n->{
'tid'
}} eq $$oldtid) {
    $n->{
'rc'
}++;
    ${$n->{
'grc'
}}++;
  } elsif (${$n->{
'tid'
}} eq $$tid) {
    $n->{
'rc'
}--;
    ${$n->{
'grc'
}}--;
    ## Is it necessary to test whether rc is 0 or not
    ## and if so call "destroy" method?  Maybe it need not
    ## (or should not, rather).
  }
}


;}
}
sub _is_same_node ($$) {
my ($self, $node) = @_;
my $r;

{

if 
(ref $node and
    UNIVERSAL::isa ($node, 
'Message::Util::ManakaiNode::ManakaiNodeStem'
) and
    $node->{
'nid'
} eq $self->{
'nid'
}) {
  $r = 
1
;
}


;}
$r}
sub _orphanate ($) {
my ($self) = @_;

{

if 
($self->
_is_externally_referred
) {
  my $grc = 0;
  $self->
_change_tree_id

               (\(
(
  'tag:suika.fam.cx,2005-09:' . time . ':' . $$ . ':' .
  ($Message::Util::ManakaiNode::UniqueIDR ||=
    [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
        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
        0 1 2 3 4 5 6 7 8 9/]->[rand 62] .
    [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
        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
        0 1 2 3 4 5 6 7 8 9/]->[rand 62] .
    [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
        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
        0 1 2 3 4 5 6 7 8 9/]->[rand 62] .
    [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
        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
        0 1 2 3 4 5 6 7 8 9/]->[rand 62] .
    [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
        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
        0 1 2 3 4 5 6 7 8 9/]->[rand 62]) .
  (++$Message::Util::ManakaiNode::UniqueIDN)
)
), \$grc);
} else {
  $self->
_destroy
;
}


;}
}
use overload 
bool => sub () {1}, 
'eq' => '_is_same_node', 
fallback => 1;
$Message::DOM::ClassFeature{q<Message::Util::ManakaiNode::ManakaiNodeStem>} = {};
$Message::DOM::ClassPoint{q<Message::Util::ManakaiNode::ManakaiNodeStem>} = 0;
package Message::Util::ManakaiNode::ManakaiNodeRef;
our $VERSION = 20051123.0820;
push our @ISA, 'Message::Util::IF::NodeRef';
sub free ($) {
my ($self) = @_;

{


$self->{
'node'
}->
_destroy
;


;}
}
sub DESTROY ($) {
my ($self) = @_;

{

if 
(my $node = $self->{
'node'
}) {
  CORE::delete $self->{
'node'
};
  unless ($self->{
'w'
}) {
    $node->{
'rc'
}--;
    ${$node->{
'grc'
}}--;
    unless (
(${$node->{'grc'}} > 0)
) {
      $node->
_destroy
;
    }
  }
} else {
  warn ref ($self) . q{->DESTROY: there is no associated }.
       q{node object - you have a global variable or }.
       qq{potential memory-leak detected\n};
}


;}
}
*_destroy = \&DESTROY;
$Message::DOM::ClassFeature{q<Message::Util::ManakaiNode::ManakaiNodeRef>} = {};
$Message::DOM::ClassPoint{q<Message::Util::ManakaiNode::ManakaiNodeRef>} = 0;
$Message::Util::ManakaiNode::ManakaiNodeRef::Prop{q<Message::Util::ManakaiNode::ManakaiNodeRef>} = {};
package Message::Util::IF::NodeRef;
our $VERSION = 20051123.0820;
## License: <http://suika.fam.cx/~wakaba/archive/2004/8/18/license#Perl+MPL>
1;
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;