Message/Util/ManakaiNode.pm

#!/usr/bin/perl 
## This file is automatically generated
##      at 2005-11-20T09:27:08+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 = 20051120.0927;
package Message::Util::IF::NodeStem;
our $VERSION = 20051120.0927;
package Message::Util::ManakaiNode::ManakaiNodeStem;
our $VERSION = 20051120.0927;
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};
      }

  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 _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 = 20051120.0927;
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 = 20051120.0927;
## 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.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;