Message/Util/ManakaiNode.pm

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