Message/DOM/Node.pm

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

## The |Node| interface - constants

## Definition group NodeType

## Spec: 
## <http://www.w3.org/TR/2004/REC-DOM-Level-3-Core-20040407/core.html#ID-1841493061>
## <http://suika.fam.cx/gate/2005/sw/manakai/DOM%20Extensions#anchor-23>

## 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,
  }->{$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

## TODO: childNodes
sub child_nodes ($) {
  my $self = shift;
  return $$self->{child_nodes} || [];
} # 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 text_content ($;$) {
  ## TODO: 
} # text_content

sub is_equal_node ($$) {
  return shift eq shift;
} # 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

sub child_nodes ($) {
  ## TODO: NodeList
  return ${+shift}->{child_nodes} || [];
} # child_nodes

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

## NOTE: Only applied to Elements and Documents
sub first_child ($) {
  my $self = shift;
  return $$self->{child_nodes}->[0];
} # first_child

## NOTE: Only applied to Elements and Documents
sub last_child ($) {
  my $self = shift;
  return @{$$self->{child_nodes}} ? $$self->{child_nodes}->[-1] : undef;
} # last_child

## NOTE: Only applied to Elements and Documents
sub previous_sibling ($) {
  my $self = shift;
  my $parent = $$self->{parent_node};
  return undef unless defined $parent;
  my $r;
  for (@{$$parent->{child_nodes}}) {
    if ($_ eq $self) {
      return $r;
    } else {
      $r = $_;
    }
  }
  return undef;
} # previous_sibling

package Message::IF::Node;

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