Message/DOM/Node.pm

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

## 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 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

## The |Node| interface - attribute

sub attributes ($) {
  ## NOTE: Overloaded by |Message::DOM::Element|.
  return undef;
} # attributes

## TODO: baseURI

sub child_nodes ($) {
  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

sub node_name ($) {
  ## NOTE: Overloaded by subclasses.
  return undef;
} # node_name

sub node_type ($) {
  ## NOTE: Overloaded by subclasses.
  die "Node->node_type is not defined";
} # node_type

sub node_value ($;$) {
  ## NOTE: Overloaded by subclasses.
  return undef;
} # node_value

## TODO: node_value setter

sub owner_document ($);

sub parent_node ($);

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 ($;$) {
  ## TODO: 
} # text_content

## 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;
      }
    }
  }
  push @{$$self->{child_nodes}}, $new_child;
  $$new_child->{parent_node} = $self;
  Scalar::Util::weaken ($$new_child->{parent_node});
  return $new_child;
} # append_child

## 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;
      }
    }
  }
  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;
    }
  }
  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 ($self, $value, $deep) = @_;
  ## TODO: deep
  $$self->{manakai_read_only} = $value;
} # manakai_set_read_only

package Message::IF::Node;

=head1 LICENSE

Copyright 2007 Wakaba <w@suika.fam.cx>

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 08:05:48 $
1	package Message::DOM::Node;
2	use strict;
3	our $VERSION=do{my @r=(q$Revision: 1.4 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
4	push our @ISA, 'Message::IF::Node';
5	require Scalar::Util;
6
7	## NOTE:
8	## Node
9	## + Attr (2)
10	## + AttributeDefinition (81002)
11	## + CharacterData
12	## + Comment (8)
13	## + Text (3)
14	## + CDATASection (4)
15	## + Document (9)
16	## + DocumentFragment (11)
17	## + DocumentType (10)
18	## + Element (1)
19	## + ElementTypeDefinition (81001)
20	## + Entity (6)
21	## + EntityReference (5)
22	## + Notation (12)
23	## + ProcessingInstruction (7)
24
25	use overload
26	'==' => sub {
27	return 0 unless UNIVERSAL::isa ($_[0], 'Message::IF::Node');
28	## TODO: implement is_equal_node
29	return $_[0]->is_equal_node ($_[1]);
30	},
31	'!=' => sub {
32	return not ($_[0] == $_[1]);
33	},
34	fallback => 1;
35
36	## The \|Node\| interface - constants
37
38	## Definition group NodeType
39
40	## NOTE: Numeric codes up to 200 are reserved by W3C [DOM1SE, DOM2, DOM3].
41
42	sub ELEMENT_NODE () { 1 }
43	sub ATTRIBUTE_NODE () { 2 }
44	sub TEXT_NODE () { 3 }
45	sub CDATA_SECTION_NODE () { 4 }
46	sub ENTITY_REFERENCE_NODE () { 5 }
47	sub ENTITY_NODE () { 6 }
48	sub PROCESSING_INSTRUCTION_NODE () { 7 }
49	sub COMMENT_NODE () { 8 }
50	sub DOCUMENT_NODE () { 9 }
51	sub DOCUMENT_TYPE_NODE () { 10 }
52	sub DOCUMENT_FRAGMENT_NODE () { 11 }
53	sub NOTATION_NODE () { 12 }
54	sub ELEMENT_TYPE_DEFINITION_NODE () { 81001 }
55	sub ATTRIBUTE_DEFINITION_NODE () { 81002 }
56
57	## Definition group DocumentPosition
58
59	## Spec:
60	## <http://www.w3.org/TR/2004/REC-DOM-Level-3-Core-20040407/core.html#DocumentPosition>
61
62	sub DOCUMENT_POSITION_DISCONNECTED () { 0x01 }
63	sub DOCUMENT_POSITION_PRECEDING () { 0x02 }
64	sub DOCUMENT_POSITION_FOLLOWING () { 0x04 }
65	sub DOCUMENT_POSITION_CONTAINS () { 0x08 }
66	sub DOCUMENT_POSITION_CONTAINED_BY () { 0x10 }
67	sub DOCUMENT_POSITION_IMPLEMENTATION_SPECIFIC () { 0x20 }
68
69	sub ____new ($$) {
70	my $self = bless \({}), shift;
71	$$self->{owner_document} = shift;
72	Scalar::Util::weaken ($$self->{owner_document});
73	return $self;
74	} # ____new
75
76	sub AUTOLOAD {
77	my $method_name = our $AUTOLOAD;
78	$method_name =~ s/.*:://;
79	return if $method_name eq 'DESTROY';
80
81	if ({
82	## Read-only attributes (trivial accessors)
83	owner_document => 1,
84	parent_node => 1,
85	manakai_read_only => 1,
86	}->{$method_name}) {
87	no strict 'refs';
88	eval qq{
89	sub $method_name (\$) {
90	return \${\$_[0]}->{$method_name};
91	}
92	};
93	goto &{ $AUTOLOAD };
94	} elsif ({
95	## Read-write attributes (DOMString, trivial accessors)
96	}->{$method_name}) {
97	no strict 'refs';
98	eval qq{
99	sub $method_name (\$;\$) {
100	if (\@_ > 1) {
101	\${\$_[0]}->{$method_name} = ''.\$_[1];
102	}
103	return \${\$_[0]}->{$method_name};
104	}
105	};
106	goto &{ $AUTOLOAD };
107	} else {
108	require Carp;
109	Carp::croak (qq<Can't locate method "$AUTOLOAD">);
110	}
111	} # AUTOLOAD
112
113	## The \|Node\| interface - attribute
114
115	sub attributes ($) {
116	## NOTE: Overloaded by \|Message::DOM::Element\|.
117	return undef;
118	} # attributes
119
120	## TODO: baseURI
121
122	sub child_nodes ($) {
123	require Message::DOM::NodeList;
124	return bless \\($_[0]), 'Message::DOM::NodeList::ChildNodeList';
125	} # child_nodes
126
127	sub first_child ($) {
128	my $self = shift;
129	return $$self->{child_nodes} ? $$self->{child_nodes}->[0] : undef;
130	} # first_child
131
132	sub last_child ($) {
133	my $self = shift;
134	return $$self->{child_nodes} && $$self->{child_nodes}->[0]
135	? $$self->{child_nodes}->[-1] : undef;
136	} # last_child
137
138	sub local_name ($) { undef }
139	sub manakai_local_name ($) { undef }
140
141	sub namespace_uri ($) { undef }
142
143	sub next_sibling ($) {
144	my $self = shift;
145	my $parent = $$self->{parent_node};
146	return undef unless defined $parent;
147	my $has_self;
148	for (@{$parent->child_nodes}) {
149	if ($_ eq $self) {
150	$has_self = 1;
151	} elsif ($has_self) {
152	return $_;
153	}
154	}
155	return undef;
156	} # next_sibling
157
158	sub node_name ($) {
159	## NOTE: Overloaded by subclasses.
160	return undef;
161	} # node_name
162
163	sub node_type ($) {
164	## NOTE: Overloaded by subclasses.
165	die "Node->node_type is not defined";
166	} # node_type
167
168	sub node_value ($;$) {
169	## NOTE: Overloaded by subclasses.
170	return undef;
171	} # node_value
172
173	## TODO: node_value setter
174
175	sub owner_document ($);
176
177	sub parent_node ($);
178
179	sub prefix ($;$) { undef }
180
181	sub previous_sibling ($) {
182	my $self = shift;
183	my $parent = $$self->{parent_node};
184	return undef unless defined $parent;
185	my $prev;
186	for (@{$parent->child_nodes}) {
187	if ($_ eq $self) {
188	return $prev;
189	} else {
190	$prev = $_;
191	}
192	}
193	return undef;
194	} # previous_sibling
195
196	sub manakai_read_only ($);
197
198	sub text_content ($;$) {
199	## TODO:
200	} # text_content
201
202	## TODO:
203	sub is_same_node ($$) {
204	return $_[0] eq $_[1];
205	} # is_same_node
206
207	## TODO:
208	sub is_equal_node ($$) {
209	return $_[0]->node_name eq $_[1]->node_name &&
210	$_[0]->node_value eq $_[1]->node_value;
211	} # is_equal_node
212
213	sub manakai_parent_element ($) {
214	my $self = shift;
215	my $parent = $$self->{parent_node};
216	while (defined $parent) {
217	if ($parent->node_type == 1) { # ELEMENT_NODE
218	return $parent;
219	} else {
220	$parent = $$parent->{parent_node};
221	}
222	}
223	return undef;
224	} # manakai_parent_element
225
226	## NOTE: Only applied to Elements and Documents
227	sub append_child ($$) {
228	my ($self, $new_child) = @_;
229	if (defined $$new_child->{parent_node}) {
230	my $parent_list = ${$$new_child->{parent_node}}->{child_nodes};
231	for (0..$#$parent_list) {
232	if ($parent_list->[$_] eq $new_child) {
233	splice @$parent_list, $_, 1;
234	}
235	}
236	}
237	push @{$$self->{child_nodes}}, $new_child;
238	$$new_child->{parent_node} = $self;
239	Scalar::Util::weaken ($$new_child->{parent_node});
240	return $new_child;
241	} # append_child
242
243	## NOTE: Only applied to Elements and Documents
244	sub insert_before ($$;$) {
245	my ($self, $new_child, $ref_child) = @_;
246	if (defined $$new_child->{parent_node}) {
247	my $parent_list = ${$$new_child->{parent_node}}->{child_nodes};
248	for (0..$#$parent_list) {
249	if ($parent_list->[$_] eq $new_child) {
250	splice @$parent_list, $_, 1;
251	}
252	}
253	}
254	my $i = @{$$self->{child_nodes}};
255	if (defined $ref_child) {
256	for (0..$#{$$self->{child_nodes}}) {
257	if ($$self->{child_nodes}->[$_] eq $ref_child) {
258	$i = $_;
259	last;
260	}
261	}
262	}
263	splice @{$$self->{child_nodes}}, $i, 0, $new_child;
264	$$new_child->{parent_node} = $self;
265	Scalar::Util::weaken ($$new_child->{parent_node});
266	return $new_child;
267	} # insert_before
268
269	## NOTE: Only applied to Elements and Documents
270	sub remove_child ($$) {
271	my ($self, $old_child) = @_;
272	my $parent_list = $$self->{child_nodes};
273	for (0..$#$parent_list) {
274	if ($parent_list->[$_] eq $old_child) {
275	splice @$parent_list, $_, 1;
276	}
277	}
278	delete $$old_child->{parent_node};
279	return $old_child;
280	} # remove_child
281
282	## NOTE: Only applied to Elements and Documents
283	sub has_child_nodes ($) {
284	return @{${+shift}->{child_nodes}} > 0;
285	} # has_child_nodes
286
287	sub manakai_set_read_only ($;$$) {
288	my ($self, $value, $deep) = @_;
289	## TODO: deep
290	$$self->{manakai_read_only} = $value;
291	} # manakai_set_read_only
292
293	package Message::IF::Node;
294
295	=head1 LICENSE
296
297	Copyright 2007 Wakaba <w@suika.fam.cx>
298
299	This program is free software; you can redistribute it and/or
300	modify it under the same terms as Perl itself.
301
302	=cut
303
304	1;
305	## $Date: 2007/06/16 08:05:48 $