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	#!/usr/bin/perl
2	## This file is automatically generated
3	## at 2006-12-31T09:20:46+00:00,
4	## from file "ManakaiNode.dis",
5	## module <http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/ManakaiNode>.
6	## Don't edit by hand!
7	use strict;
8	package Message::Util::ManakaiNode;
9	our $VERSION = 20061231.0920;
10	package Message::Util::IF::NodeStem;
11	our $VERSION = 20061231.0920;
12	package Message::Util::ManakaiNode::ManakaiNodeStem;
13	our $VERSION = 20061231.0920;
14	push our @ISA, 'Message::Util::IF::NodeStem';
15	sub _new ($$) {
16	my ($self, $className) = @_;
17	my $r;
18
19	{
20
21	my
22	$grc = 0;
23	$r = bless {
24
25	't'
26	=> $className,
27
28	'grc'
29	=> \$grc,
30
31	'rc'
32	=> 0,
33
34	'tid'
35	=> \ (
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	)
56	),
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
83
84	}
85	$r}
86	sub _new_node ($$) {
87	my ($self, $className) = @_;
88	my $r;
89
90	{
91
92
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	'nid'
113	=>
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	)
134	,
135	}, ref $self;
136
137
138	}
139	$r}
140	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	NODES: while (@node) {
157	my $node = shift @node;
158	next NODES unless ref $node;
159	if ($node->{
160	'rc'
161	}) {
162	$r =
163	1
164	;
165	last NODES;
166	} elsif ($checked{$node->{
167	'nid'
168	}}) {
169	next NODES;
170	}
171	my @n;
172	my $nt = $Message::Util::ManakaiNode::ManakaiNodeRef::Prop{
173	$node->{
174	't'
175	}
176	};
177	for my $p (@{$nt->{
178	's2'
179	}}) {
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	map {$node->{$_}} @{$nt->{
188	's'
189	}}) {
190	if (ref $p eq 'ARRAY') {
191	push @node, @$p;
192	} elsif (ref $p eq 'HASH') {
193	push @node, values %$p;
194	}
195	}
196	for my $p (@{$nt->{
197	'o'
198	}}) {
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	for my $p (@{$nt->{
205	's0'
206	}}) {
207	push @node, $node->{$p} if $node->{$p};
208	}
209	$checked{$node->{
210	'nid'
211	}} =
212	1
213	;
214	}
215	}
216
217
218	}
219	$r}
220	sub _destroy ($) {
221	my ($self) = @_;
222
223	{
224
225	my
226	@node = ($self);
227	my $tid = $self->{
228	'tid'
229	} \|\| \'';
230	my %xrnode;
231	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	my $ref = ref $node->{$p};
246	if ($ref eq 'HASH') {
247	push @n, values %{$node->{$p}};
248	} elsif ($ref eq 'ARRAY') {
249	push @n, @{$node->{$p}};
250	}
251	}
252	for my $p (@n, map {$node->{$_}} @{$nt->{
253	's'
254	}\|\|[]}) {
255	my $ref = ref $p;
256	if ($ref eq 'ARRAY') {
257	push @node, @$p;
258	} elsif ($ref eq 'HASH') {
259	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
271	$node->
272	_destroy_node_stem
273	;
274
275	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	%$node = ();
295	} # @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	}
307
308
309	}
310	}
311	sub _destroy_node_stem ($) {
312	my ($self) = @_;
313
314	{
315
316
317	## No action by default
318
319
320	}
321	}
322	sub _import_tree ($$) {
323	my ($self, $node) = @_;
324
325	{
326
327	my
328	@node = ($node);
329	my $newgrc = $self->{
330	'grc'
331	};
332	my $newtid = $self->{
333	'tid'
334	};
335	my $oldtid = $node->{
336	'tid'
337	};
338	my @xrnode;
339	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	my $ref = ref $node->{$p};
355	if ($ref eq 'HASH') {
356	push @n, values %{$node->{$p}};
357	} elsif ($ref eq 'ARRAY') {
358	push @n, @{$node->{$p}};
359	}
360	}
361	for my $p (@n, map {$node->{$_}} @{$nt->{
362	's'
363	}\|\|[]}) {
364	my $ref = ref $p;
365	if ($ref eq 'ARRAY') {
366	push @node, @$p;
367	} elsif ($ref eq 'HASH') {
368	push @node, values %$p;
369	}
370	}
371	for my $p (@{$nt->{
372	'o'
373	}\|\|[]},
374	@{$nt->{
375	's0'
376	}\|\|[]}) {
377	push @node, $node->{$p} if defined $node->{$p};
378	}
379
380	for (@{$nt->{
381	'x'
382	}\|\|[]}) {
383	push @xrnode, $node->{$_} if defined $node->{$_};
384	}
385
386	${$node->{
387	'grc'
388	}} -= $node->{
389	'rc'
390	};
391	$node->{
392	'tid'
393	} = $newtid;
394	$node->{
395	'grc'
396	} = $newgrc;
397	$$newgrc += $node->{
398	'rc'
399	};
400	}
401
402	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
428	}
429	}
430	sub _change_tree_id ($$$) {
431	my ($self, $treeID, $groveRC) = @_;
432
433	{
434
435	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	my @n;
449	my $nt = $Message::Util::ManakaiNode::ManakaiNodeRef::Prop{
450	$node->{
451	't'
452	}
453	};
454	for my $p (@{$nt->{
455	's2'
456	}\|\|[]}) {
457	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	map {$node->{$_}} @{$nt->{
465	's'
466	}\|\|[]}) {
467	if (ref $p eq 'ARRAY') {
468	push @node, @$p;
469	} elsif (ref $p eq 'HASH') {
470	push @node, values %$p;
471	}
472	}
473	for my $p (@{$nt->{
474	'o'
475	}\|\|[]},
476	@{$nt->{
477	's0'
478	}\|\|[]}) {
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	}
529	}
530
531
532	}
533	}
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	'Message::Util::ManakaiNode::ManakaiNodeStem'
544	) and
545	$node->{
546	'nid'
547	} eq $self->{
548	'nid'
549	}) {
550	$r =
551	1
552	;
553	}
554
555
556	}
557	$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	'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	)
592	), \$grc);
593	} else {
594	$self->
595	_destroy
596	;
597	}
598
599
600	}
601	}
602	use overload
603	bool => sub () {1},
604	'eq' => '_is_same_node',
605	fallback => 1;
606	$Message::DOM::DOMFeature::ClassInfo->{q<Message::Util::ManakaiNode::ManakaiNodeStem>}->{has_feature} = {};
607	$Message::DOM::ClassPoint{q<Message::Util::ManakaiNode::ManakaiNodeStem>} = 0;
608	package Message::Util::ManakaiNode::ManakaiNodeRef;
609	our $VERSION = 20061231.0920;
610	push our @ISA, 'Message::Util::IF::NodeRef';
611	sub free ($) {
612	my ($self) = @_;
613
614	{
615
616
617	$self->{
618	'node'
619	}->
620	_destroy
621	;
622
623
624	}
625	}
626	sub DESTROY ($) {
627	my ($self) = @_;
628
629	{
630
631	if
632	(my $node = $self->{
633	'node'
634	}) {
635	CORE::delete $self->{
636	'node'
637	};
638	unless ($self->{
639	'w'
640	}) {
641	$node->{
642	'rc'
643	}--;
644	${$node->{
645	'grc'
646	}}--;
647	unless (
648	(${$node->{'grc'}} > 0)
649	) {
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	}
663	}
664	*_destroy = \&DESTROY;
665	$Message::DOM::DOMFeature::ClassInfo->{q<Message::Util::ManakaiNode::ManakaiNodeRef>}->{has_feature} = {};
666	$Message::DOM::ClassPoint{q<Message::Util::ManakaiNode::ManakaiNodeRef>} = 0;
667	$Message::Util::ManakaiNode::ManakaiNodeRef::Prop{q<Message::Util::ManakaiNode::ManakaiNodeRef>} = {};
668	package Message::Util::IF::NodeRef;
669	our $VERSION = 20061231.0920;
670	## License: <http://suika.fam.cx/~wakaba/archive/2004/8/18/license#Perl+MPL>
671	1;