Message/DOM/Node.pm

package Message::DOM::Node;
use strict;
our $VERSION=do{my @r=(q$Revision: 1.6 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
push our @ISA, 'Message::IF::Node';
require Scalar::Util;
require Message::DOM::DOMException;

## NOTE:
##   Node
##   + Attr (2)
##   + AttributeDefinition (81002)
##   + CharacterData
##     + Comment (8)
##     + Text (3)
##       + CDATASection (4)
##   + Document (9)
##   + DocumentFragment (11)
##   + DocumentType (10)
##   + Element (1)
##   + ElementTypeDefinition (81001)
##   + Entity (6)
##   + EntityReference (5)
##   + Notation (12)
##   + ProcessingInstruction (7)

use overload
    '==' => sub {
      return 0 unless UNIVERSAL::isa ($_[0], 'Message::IF::Node');
      ## TODO: implement is_equal_node
      return $_[0]->is_equal_node ($_[1]);
    },
    '!=' => sub {
      return not ($_[0] == $_[1]);
    },
    fallback => 1;

## The |Node| interface - constants

## Definition group NodeType

## NOTE: Numeric codes up to 200 are reserved by W3C [DOM1SE, DOM2, DOM3].

sub ELEMENT_NODE () { 1 }
sub ATTRIBUTE_NODE () { 2 }
sub TEXT_NODE () { 3 }
sub CDATA_SECTION_NODE () { 4 }
sub ENTITY_REFERENCE_NODE () { 5 }
sub ENTITY_NODE () { 6 }
sub PROCESSING_INSTRUCTION_NODE () { 7 }
sub COMMENT_NODE () { 8 }
sub DOCUMENT_NODE () { 9 }
sub DOCUMENT_TYPE_NODE () { 10 }
sub DOCUMENT_FRAGMENT_NODE () { 11 }
sub NOTATION_NODE () { 12 }
sub ELEMENT_TYPE_DEFINITION_NODE () { 81001 }
sub ATTRIBUTE_DEFINITION_NODE () { 81002 }

## Definition group DocumentPosition

## Spec:
## <http://www.w3.org/TR/2004/REC-DOM-Level-3-Core-20040407/core.html#DocumentPosition>

sub DOCUMENT_POSITION_DISCONNECTED () { 0x01 }
sub DOCUMENT_POSITION_PRECEDING () { 0x02 }
sub DOCUMENT_POSITION_FOLLOWING () { 0x04 }
sub DOCUMENT_POSITION_CONTAINS () { 0x08 }
sub DOCUMENT_POSITION_CONTAINED_BY () { 0x10 }
sub DOCUMENT_POSITION_IMPLEMENTATION_SPECIFIC () { 0x20 }

sub ____new ($$) {
  my $self = bless \({}), shift;
  $$self->{owner_document} = shift;
  Scalar::Util::weaken ($$self->{owner_document});
  return $self;
} # ____new

sub ___report_error ($$) {
  $_[1]->throw;
} # ___report_error

sub AUTOLOAD {
  my $method_name = our $AUTOLOAD;
  $method_name =~ s/.*:://;
  return if $method_name eq 'DESTROY';

  if ({
    ## Read-only attributes (trivial accessors)
    owner_document => 1,
    parent_node => 1,
    manakai_read_only => 1,
  }->{$method_name}) {
    no strict 'refs';
    eval qq{
      sub $method_name (\$) {
        return \${\$_[0]}->{$method_name}; 
      }
    };
    goto &{ $AUTOLOAD };
  } elsif ({
    ## Read-write attributes (DOMString, trivial accessors)
  }->{$method_name}) {
    no strict 'refs';
    eval qq{
      sub $method_name (\$;\$) {
        if (\@_ > 1) {
          \${\$_[0]}->{$method_name} = ''.\$_[1];
        }
        return \${\$_[0]}->{$method_name}; 
      }
    };
    goto &{ $AUTOLOAD };
  } else {
    require Carp;
    Carp::croak (qq<Can't locate method "$AUTOLOAD">);
  }
} # AUTOLOAD

## |Node| attributes

## NOTE: Overridden by |Element|.
sub attributes () { undef }

sub base_uri ($) {
  ## NOTE: Overridden by |Attr|, |CharacterData|, |Document|, |DocumentType|,
  ## |Element|, |EntityReference|, and |ProcessingInstruction|.

  local $Error::Depth = $Error::Depth + 1;
  return $_[0]->owner_document->base_uri;
} # base_uri

sub child_nodes ($) {
  ## NOTE: Overridden by |CharacterData|, |ElementTypeDefinition|,
  ## |Notation|, and |ProcessingInstruction|.
  require Message::DOM::NodeList;
  return bless \\($_[0]), 'Message::DOM::NodeList::ChildNodeList';
} # child_nodes

sub first_child ($) {
  my $self = shift;
  return $$self->{child_nodes} ? $$self->{child_nodes}->[0] : undef;
} # first_child

sub last_child ($) {
  my $self = shift;
  return $$self->{child_nodes} && $$self->{child_nodes}->[0]
    ? $$self->{child_nodes}->[-1] : undef;
} # last_child

sub local_name { undef }

sub manakai_local_name { undef }

sub namespace_uri { undef }

sub next_sibling ($) {
  my $self = shift;
  my $parent = $$self->{parent_node};
  return undef unless defined $parent;
  my $has_self;
  for (@{$parent->child_nodes}) {
    if ($_ eq $self) {
      $has_self = 1;
    } elsif ($has_self) {
      return $_;
    }
  }
  return undef;
} # next_sibling

## NOTE: Overridden by subclasses.
sub node_name () { undef }

## NOTE: Overridden by subclasses.
sub node_type () { }

## NOTE: Overridden by |Attr|, |AttributeDefinition|,
## |CharacterData|, and |ProcessingInstruction|.
sub node_value () { undef }

sub owner_document ($);

sub parent_node ($);

## NOTE: Overridden by |Element| and |Attr|.
sub prefix ($;$) { undef }

sub previous_sibling ($) {
  my $self = shift;
  my $parent = $$self->{parent_node};
  return undef unless defined $parent;
  my $prev;
  for (@{$parent->child_nodes}) {
    if ($_ eq $self) {
      return $prev;
    } else {
      $prev = $_;
    }
  }
  return undef;
} # previous_sibling

sub manakai_read_only ($);

sub text_content ($;$) {
  ## NOTE: For |Element|, |Attr|, |Entity|, |EntityReference|,
  ## |DocumentFragment|, and |AttributeDefinition|.  In addition,
  ## |Document|'s |text_content| might call this attribute.
  
  ## NOTE: Overridden by |Document|, |DocumentType|, |Notation|,
  ## |CharacterData|, |ProcessingInstruction|, and |ElementTypeDefinition|.

  my $self = $_[0];

  if (@_ > 1) {
    if (${$$self->{owner_document} or $self}->{strict_error_checking} and
        $$self->{manakai_read_only}) {
      report Message::DOM::DOMException
          -object => $self,
          -type => 'NO_MODIFICATION_ALLOWED_ERR',
          -subtype => 'READ_ONLY_NODE_ERR';
    }
    
    local $Error::Depth = $Error::Depth + 1;
    @{$self->child_nodes} = ();
    if (defined $_[1] and length $_[1]) {
      ## NOTE: |DocumentType| don't use this code.
      my $text = ($$self->{owner_document} || $self)->create_text_node ($_[1]);
      $self->append_child ($text);
    }    
  }

  if (defined wantarray) {
    local $Error::Depth = $Error::Depth + 1;
    my $r = '';
    my @node = @{$self->child_nodes};
    while (@node) {
      my $child = shift @node;
      my $child_nt = $child->node_type;
      if ($child_nt == TEXT_NODE or $child_nt == CDATA_SECTION_NODE) {
        $r .= $child->node_value unless $child->is_element_content_whitespace;
      } elsif ($child_nt == COMMENT_NODE or
               $child_nt == PROCESSING_INSTRUCTION_NODE or
               $child_nt == DOCUMENT_TYPE_NODE) {
        #
      } else {
        unshift @node, @{$child->child_nodes};
      }
    }
    return $r;
  }
} # text_content

## |Node| methods

## TODO:
sub is_same_node ($$) {
  return $_[0] eq $_[1];
} # is_same_node

## TODO:
sub is_equal_node ($$) {
  return $_[0]->node_name eq $_[1]->node_name &&
    $_[0]->node_value eq $_[1]->node_value;
} # is_equal_node

sub manakai_parent_element ($) {
  my $self = shift;
  my $parent = $$self->{parent_node};
  while (defined $parent) {
    if ($parent->node_type == 1) { # ELEMENT_NODE
      return $parent;
    } else {
      $parent = $$parent->{parent_node};
    }
  }
  return undef;
} # manakai_parent_element

## NOTE: Only applied to Elements and Documents
sub append_child ($$) {
  my ($self, $new_child) = @_;
  if (defined $$new_child->{parent_node}) {
    my $parent_list = ${$$new_child->{parent_node}}->{child_nodes};
    for (0..$#$parent_list) {
      if ($parent_list->[$_] eq $new_child) {
        splice @$parent_list, $_, 1;
        last;
      }
    }
  }
  push @{$$self->{child_nodes}}, $new_child;
  $$new_child->{parent_node} = $self;
  Scalar::Util::weaken ($$new_child->{parent_node});
  ## TODO:
  $$new_child->{owner_document} = $self if $self->node_type == DOCUMENT_NODE;
  return $new_child;
} # append_child

sub manakai_append_text ($$) {
  ## NOTE: For |Element|, |Attr|, |Entity|, |EntityReference|,
  ## |DocumentFragment|, and |AttributeDefinition|.  In addition,
  ## |Document|'s |text_content| might call this attribute.
  
  ## NOTE: Overridden by |Document|, |DocumentType|, |CharacterData|, 
  ## |ElementTypeDefinition|, |Notation|, and |ProcessingInstruction|.

  my $self = $_[0];
  local $Error::Depth = $Error::Depth + 1;
  if (@{$$self->{child_nodes}} and
      $$self->{child_nodes}->[-1]->node_type == TEXT_NODE) {
    $$self->{child_nodes}->[-1]->manakai_append_text ($_[1]);
  } else {
    my $text = ($$self->{owner_document} or $self)->create_text_node ($_[1]);
    $self->append_child ($text);
  }
} # manakai_append_text

sub get_feature {
  ## TODO:
  return $_[0];
}

## NOTE: Only applied to Elements and Documents
sub insert_before ($$;$) {
  my ($self, $new_child, $ref_child) = @_;
  if (defined $$new_child->{parent_node}) {
    my $parent_list = ${$$new_child->{parent_node}}->{child_nodes};
    for (0..$#$parent_list) {
      if ($parent_list->[$_] eq $new_child) {
        splice @$parent_list, $_, 1;
        last;
      }
    }
  }
  my $i = @{$$self->{child_nodes}};
  if (defined $ref_child) {
    for (0..$#{$$self->{child_nodes}}) {
      if ($$self->{child_nodes}->[$_] eq $ref_child) {
        $i = $_;
        last;
      }
    }
  }
  splice @{$$self->{child_nodes}}, $i, 0, $new_child;
  $$new_child->{parent_node} = $self;
  Scalar::Util::weaken ($$new_child->{parent_node});
  return $new_child;
} # insert_before

## NOTE: Only applied to Elements and Documents
sub remove_child ($$) {
  my ($self, $old_child) = @_;
  my $parent_list = $$self->{child_nodes};
  for (0..$#$parent_list) {
    if ($parent_list->[$_] eq $old_child) {
      splice @$parent_list, $_, 1;
      last;
    }
  }
  delete $$old_child->{parent_node};
  return $old_child;
} # remove_child

## NOTE: Only applied to Elements and Documents
sub has_child_nodes ($) {
  return @{${+shift}->{child_nodes}} > 0;
} # has_child_nodes

sub manakai_set_read_only ($;$$) {
  my $value = 1 if $_[1];
  if ($_[2]) {
    my @target = ($_[0]);
    while (@target) {
      my $target = shift @target;
      if ($value) {
        $$target->{manakai_read_only} = 1;
      } else {
        delete $$target->{manakai_read_only};
      }
      push @target, @{$target->child_nodes};
      
      my $nt = $target->node_type;
      if ($nt == ELEMENT_NODE) {
        push @target, @{$target->attributes};
      } elsif ($nt == ELEMENT_TYPE_DEFINITION_NODE) {
        push @target, @{$target->attribute_definitions};
      } elsif ($nt == DOCUMENT_TYPE_NODE) {
        push @target, @{$target->element_types};
        push @target, @{$target->general_entities};
        push @target, @{$target->notations};
      }
    }
  } else { # not deep
    if ($value) {
      ${$_[0]}->{manakai_read_only} = 1;
    } else {
      delete ${$_[0]}->{manakai_read_only};
    }
  }
} # manakai_set_read_only

package Message::IF::Node;

=head1 LICENSE

Copyright 2007 Wakaba <[email protected]>

This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=cut

1;
## $Date: 2007/06/16 15:27:45 $
1	package Message::DOM::Node;
2	use strict;
3	our $VERSION=do{my @r=(q$Revision: 1.6 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
4	push our @ISA, 'Message::IF::Node';
5	require Scalar::Util;
6	require Message::DOM::DOMException;
7
8	## NOTE:
9	## Node
10	## + Attr (2)
11	## + AttributeDefinition (81002)
12	## + CharacterData
13	## + Comment (8)
14	## + Text (3)
15	## + CDATASection (4)
16	## + Document (9)
17	## + DocumentFragment (11)
18	## + DocumentType (10)
19	## + Element (1)
20	## + ElementTypeDefinition (81001)
21	## + Entity (6)
22	## + EntityReference (5)
23	## + Notation (12)
24	## + ProcessingInstruction (7)
25
26	use overload
27	'==' => sub {
28	return 0 unless UNIVERSAL::isa ($_[0], 'Message::IF::Node');
29	## TODO: implement is_equal_node
30	return $_[0]->is_equal_node ($_[1]);
31	},
32	'!=' => sub {
33	return not ($_[0] == $_[1]);
34	},
35	fallback => 1;
36
37	## The \|Node\| interface - constants
38
39	## Definition group NodeType
40
41	## NOTE: Numeric codes up to 200 are reserved by W3C [DOM1SE, DOM2, DOM3].
42
43	sub ELEMENT_NODE () { 1 }
44	sub ATTRIBUTE_NODE () { 2 }
45	sub TEXT_NODE () { 3 }
46	sub CDATA_SECTION_NODE () { 4 }
47	sub ENTITY_REFERENCE_NODE () { 5 }
48	sub ENTITY_NODE () { 6 }
49	sub PROCESSING_INSTRUCTION_NODE () { 7 }
50	sub COMMENT_NODE () { 8 }
51	sub DOCUMENT_NODE () { 9 }
52	sub DOCUMENT_TYPE_NODE () { 10 }
53	sub DOCUMENT_FRAGMENT_NODE () { 11 }
54	sub NOTATION_NODE () { 12 }
55	sub ELEMENT_TYPE_DEFINITION_NODE () { 81001 }
56	sub ATTRIBUTE_DEFINITION_NODE () { 81002 }
57
58	## Definition group DocumentPosition
59
60	## Spec:
61	## <http://www.w3.org/TR/2004/REC-DOM-Level-3-Core-20040407/core.html#DocumentPosition>
62
63	sub DOCUMENT_POSITION_DISCONNECTED () { 0x01 }
64	sub DOCUMENT_POSITION_PRECEDING () { 0x02 }
65	sub DOCUMENT_POSITION_FOLLOWING () { 0x04 }
66	sub DOCUMENT_POSITION_CONTAINS () { 0x08 }
67	sub DOCUMENT_POSITION_CONTAINED_BY () { 0x10 }
68	sub DOCUMENT_POSITION_IMPLEMENTATION_SPECIFIC () { 0x20 }
69
70	sub ____new ($$) {
71	my $self = bless \({}), shift;
72	$$self->{owner_document} = shift;
73	Scalar::Util::weaken ($$self->{owner_document});
74	return $self;
75	} # ____new
76
77	sub ___report_error ($$) {
78	$_[1]->throw;
79	} # ___report_error
80
81	sub AUTOLOAD {
82	my $method_name = our $AUTOLOAD;
83	$method_name =~ s/.*:://;
84	return if $method_name eq 'DESTROY';
85
86	if ({
87	## Read-only attributes (trivial accessors)
88	owner_document => 1,
89	parent_node => 1,
90	manakai_read_only => 1,
91	}->{$method_name}) {
92	no strict 'refs';
93	eval qq{
94	sub $method_name (\$) {
95	return \${\$_[0]}->{$method_name};
96	}
97	};
98	goto &{ $AUTOLOAD };
99	} elsif ({
100	## Read-write attributes (DOMString, trivial accessors)
101	}->{$method_name}) {
102	no strict 'refs';
103	eval qq{
104	sub $method_name (\$;\$) {
105	if (\@_ > 1) {
106	\${\$_[0]}->{$method_name} = ''.\$_[1];
107	}
108	return \${\$_[0]}->{$method_name};
109	}
110	};
111	goto &{ $AUTOLOAD };
112	} else {
113	require Carp;
114	Carp::croak (qq<Can't locate method "$AUTOLOAD">);
115	}
116	} # AUTOLOAD
117
118	## \|Node\| attributes
119
120	## NOTE: Overridden by \|Element\|.
121	sub attributes () { undef }
122
123	sub base_uri ($) {
124	## NOTE: Overridden by \|Attr\|, \|CharacterData\|, \|Document\|, \|DocumentType\|,
125	## \|Element\|, \|EntityReference\|, and \|ProcessingInstruction\|.
126
127	local $Error::Depth = $Error::Depth + 1;
128	return $_[0]->owner_document->base_uri;
129	} # base_uri
130
131	sub child_nodes ($) {
132	## NOTE: Overridden by \|CharacterData\|, \|ElementTypeDefinition\|,
133	## \|Notation\|, and \|ProcessingInstruction\|.
134	require Message::DOM::NodeList;
135	return bless \\($_[0]), 'Message::DOM::NodeList::ChildNodeList';
136	} # child_nodes
137
138	sub first_child ($) {
139	my $self = shift;
140	return $$self->{child_nodes} ? $$self->{child_nodes}->[0] : undef;
141	} # first_child
142
143	sub last_child ($) {
144	my $self = shift;
145	return $$self->{child_nodes} && $$self->{child_nodes}->[0]
146	? $$self->{child_nodes}->[-1] : undef;
147	} # last_child
148
149	sub local_name { undef }
150
151	sub manakai_local_name { undef }
152
153	sub namespace_uri { undef }
154
155	sub next_sibling ($) {
156	my $self = shift;
157	my $parent = $$self->{parent_node};
158	return undef unless defined $parent;
159	my $has_self;
160	for (@{$parent->child_nodes}) {
161	if ($_ eq $self) {
162	$has_self = 1;
163	} elsif ($has_self) {
164	return $_;
165	}
166	}
167	return undef;
168	} # next_sibling
169
170	## NOTE: Overridden by subclasses.
171	sub node_name () { undef }
172
173	## NOTE: Overridden by subclasses.
174	sub node_type () { }
175
176	## NOTE: Overridden by \|Attr\|, \|AttributeDefinition\|,
177	## \|CharacterData\|, and \|ProcessingInstruction\|.
178	sub node_value () { undef }
179
180	sub owner_document ($);
181
182	sub parent_node ($);
183
184	## NOTE: Overridden by \|Element\| and \|Attr\|.
185	sub prefix ($;$) { undef }
186
187	sub previous_sibling ($) {
188	my $self = shift;
189	my $parent = $$self->{parent_node};
190	return undef unless defined $parent;
191	my $prev;
192	for (@{$parent->child_nodes}) {
193	if ($_ eq $self) {
194	return $prev;
195	} else {
196	$prev = $_;
197	}
198	}
199	return undef;
200	} # previous_sibling
201
202	sub manakai_read_only ($);
203
204	sub text_content ($;$) {
205	## NOTE: For \|Element\|, \|Attr\|, \|Entity\|, \|EntityReference\|,
206	## \|DocumentFragment\|, and \|AttributeDefinition\|. In addition,
207	## \|Document\|'s \|text_content\| might call this attribute.
208
209	## NOTE: Overridden by \|Document\|, \|DocumentType\|, \|Notation\|,
210	## \|CharacterData\|, \|ProcessingInstruction\|, and \|ElementTypeDefinition\|.
211
212	my $self = $_[0];
213
214	if (@_ > 1) {
215	if (${$$self->{owner_document} or $self}->{strict_error_checking} and
216	$$self->{manakai_read_only}) {
217	report Message::DOM::DOMException
218	-object => $self,
219	-type => 'NO_MODIFICATION_ALLOWED_ERR',
220	-subtype => 'READ_ONLY_NODE_ERR';
221	}
222
223	local $Error::Depth = $Error::Depth + 1;
224	@{$self->child_nodes} = ();
225	if (defined $_[1] and length $_[1]) {
226	## NOTE: \|DocumentType\| don't use this code.
227	my $text = ($$self->{owner_document} \|\| $self)->create_text_node ($_[1]);
228	$self->append_child ($text);
229	}
230	}
231
232	if (defined wantarray) {
233	local $Error::Depth = $Error::Depth + 1;
234	my $r = '';
235	my @node = @{$self->child_nodes};
236	while (@node) {
237	my $child = shift @node;
238	my $child_nt = $child->node_type;
239	if ($child_nt == TEXT_NODE or $child_nt == CDATA_SECTION_NODE) {
240	$r .= $child->node_value unless $child->is_element_content_whitespace;
241	} elsif ($child_nt == COMMENT_NODE or
242	$child_nt == PROCESSING_INSTRUCTION_NODE or
243	$child_nt == DOCUMENT_TYPE_NODE) {
244	#
245	} else {
246	unshift @node, @{$child->child_nodes};
247	}
248	}
249	return $r;
250	}
251	} # text_content
252
253	## \|Node\| methods
254
255	## TODO:
256	sub is_same_node ($$) {
257	return $_[0] eq $_[1];
258	} # is_same_node
259
260	## TODO:
261	sub is_equal_node ($$) {
262	return $_[0]->node_name eq $_[1]->node_name &&
263	$_[0]->node_value eq $_[1]->node_value;
264	} # is_equal_node
265
266	sub manakai_parent_element ($) {
267	my $self = shift;
268	my $parent = $$self->{parent_node};
269	while (defined $parent) {
270	if ($parent->node_type == 1) { # ELEMENT_NODE
271	return $parent;
272	} else {
273	$parent = $$parent->{parent_node};
274	}
275	}
276	return undef;
277	} # manakai_parent_element
278
279	## NOTE: Only applied to Elements and Documents
280	sub append_child ($$) {
281	my ($self, $new_child) = @_;
282	if (defined $$new_child->{parent_node}) {
283	my $parent_list = ${$$new_child->{parent_node}}->{child_nodes};
284	for (0..$#$parent_list) {
285	if ($parent_list->[$_] eq $new_child) {
286	splice @$parent_list, $_, 1;
287	last;
288	}
289	}
290	}
291	push @{$$self->{child_nodes}}, $new_child;
292	$$new_child->{parent_node} = $self;
293	Scalar::Util::weaken ($$new_child->{parent_node});
294	## TODO:
295	$$new_child->{owner_document} = $self if $self->node_type == DOCUMENT_NODE;
296	return $new_child;
297	} # append_child
298
299	sub manakai_append_text ($$) {
300	## NOTE: For \|Element\|, \|Attr\|, \|Entity\|, \|EntityReference\|,
301	## \|DocumentFragment\|, and \|AttributeDefinition\|. In addition,
302	## \|Document\|'s \|text_content\| might call this attribute.
303
304	## NOTE: Overridden by \|Document\|, \|DocumentType\|, \|CharacterData\|,
305	## \|ElementTypeDefinition\|, \|Notation\|, and \|ProcessingInstruction\|.
306
307	my $self = $_[0];
308	local $Error::Depth = $Error::Depth + 1;
309	if (@{$$self->{child_nodes}} and
310	$$self->{child_nodes}->[-1]->node_type == TEXT_NODE) {
311	$$self->{child_nodes}->[-1]->manakai_append_text ($_[1]);
312	} else {
313	my $text = ($$self->{owner_document} or $self)->create_text_node ($_[1]);
314	$self->append_child ($text);
315	}
316	} # manakai_append_text
317
318	sub get_feature {
319	## TODO:
320	return $_[0];
321	}
322
323	## NOTE: Only applied to Elements and Documents
324	sub insert_before ($$;$) {
325	my ($self, $new_child, $ref_child) = @_;
326	if (defined $$new_child->{parent_node}) {
327	my $parent_list = ${$$new_child->{parent_node}}->{child_nodes};
328	for (0..$#$parent_list) {
329	if ($parent_list->[$_] eq $new_child) {
330	splice @$parent_list, $_, 1;
331	last;
332	}
333	}
334	}
335	my $i = @{$$self->{child_nodes}};
336	if (defined $ref_child) {
337	for (0..$#{$$self->{child_nodes}}) {
338	if ($$self->{child_nodes}->[$_] eq $ref_child) {
339	$i = $_;
340	last;
341	}
342	}
343	}
344	splice @{$$self->{child_nodes}}, $i, 0, $new_child;
345	$$new_child->{parent_node} = $self;
346	Scalar::Util::weaken ($$new_child->{parent_node});
347	return $new_child;
348	} # insert_before
349
350	## NOTE: Only applied to Elements and Documents
351	sub remove_child ($$) {
352	my ($self, $old_child) = @_;
353	my $parent_list = $$self->{child_nodes};
354	for (0..$#$parent_list) {
355	if ($parent_list->[$_] eq $old_child) {
356	splice @$parent_list, $_, 1;
357	last;
358	}
359	}
360	delete $$old_child->{parent_node};
361	return $old_child;
362	} # remove_child
363
364	## NOTE: Only applied to Elements and Documents
365	sub has_child_nodes ($) {
366	return @{${+shift}->{child_nodes}} > 0;
367	} # has_child_nodes
368
369	sub manakai_set_read_only ($;$$) {
370	my $value = 1 if $_[1];
371	if ($_[2]) {
372	my @target = ($_[0]);
373	while (@target) {
374	my $target = shift @target;
375	if ($value) {
376	$$target->{manakai_read_only} = 1;
377	} else {
378	delete $$target->{manakai_read_only};
379	}
380	push @target, @{$target->child_nodes};
381
382	my $nt = $target->node_type;
383	if ($nt == ELEMENT_NODE) {
384	push @target, @{$target->attributes};
385	} elsif ($nt == ELEMENT_TYPE_DEFINITION_NODE) {
386	push @target, @{$target->attribute_definitions};
387	} elsif ($nt == DOCUMENT_TYPE_NODE) {
388	push @target, @{$target->element_types};
389	push @target, @{$target->general_entities};
390	push @target, @{$target->notations};
391	}
392	}
393	} else { # not deep
394	if ($value) {
395	${$_[0]}->{manakai_read_only} = 1;
396	} else {
397	delete ${$_[0]}->{manakai_read_only};
398	}
399	}
400	} # manakai_set_read_only
401
402	package Message::IF::Node;
403
404	=head1 LICENSE
405
406	Copyright 2007 Wakaba <[email protected]>
407
408	This program is free software; you can redistribute it and/or
409	modify it under the same terms as Perl itself.
410
411	=cut
412
413	1;
414	## $Date: 2007/06/16 15:27:45 $