Message/DOM/NodeList.pm

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

use overload
    '@{}' => sub {
      tie my @list, ref $_[0], $_[0];
      return \@list;
    },
    eq => sub {
      return 0 unless UNIVERSAL::isa ($_[1], 'Message::DOM::NodeList');
      return $${$_[0]} eq $${$_[1]};
    },
    ne => sub {
      return not ($_[0] eq $_[1]);
    },
    '==' => sub {
      ## NOTE: Same as |StaticNodeList|'s.
      return 0 unless UNIVERSAL::isa ($_[1], 'Message::IF::NodeList');
      
      local $Error::Depth = $Error::Depth + 1;
      my $l1 = $_[0]->length;
      my $l2 = $_[1]->length;
      return 0 unless $l1 == $l2;
      
      for my $i (0 .. ($l1-1)) {
        return 0 unless $_[0]->item ($i) == $_[1]->item ($i);
      }
      
      return 1;
    },
    '!=' => sub {
      return not ($_[0] == $_[1]);
    },
    fallback => 1;

sub TIEARRAY ($$) { $_[1] }

package Message::DOM::NodeList::ChildNodeList;
push our @ISA, 'Message::DOM::NodeList';

## NOTE: |Message::DOM::CSSRuleList| has similar codes to this package.

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

## |NodeList| attributes

sub EXISTS ($$) {
  return exists ${$${$_[0]}}->{child_nodes}->[$_[1]];
} # EXISTS

sub length ($) {
  return scalar @{${$${$_[0]}}->{child_nodes}};
} # length

*FETCHSIZE = \&length;

sub STORESIZE ($$) {
  my $node = $${$_[0]};
  my $list = $$node->{child_nodes};
  my $current_length = @{$list};
  my $count = $_[1];

  local $Error::Depth = $Error::Depth + 1;
  if ($current_length > $count) {
    for (my $i = $current_length - 1; $i >= $count; $i--) {
      $node->remove_child ($list->[$i]);
    }
  }
} # STORESIZE

sub manakai_read_only ($) {
  local $Error::Depth = $Error::Depth + 1;
  return $${$_[0]}->manakai_read_only;
} # manakai_read_only

## |NodeList| methods

sub item ($$) {
  my $index = 0+$_[1];
  return undef if $index < 0;
  return ${$${$_[0]}}->{child_nodes}->[$index];
} # item

sub FETCH ($$) {
  return ${$${$_[0]}}->{child_nodes}->[$_[1]];
} # FETCH

sub STORE ($$$) {
  my $self = $_[0];
  my $list = ${$$$self}->{child_nodes};
  my $index = $_[1];
           
  local $Error::Depth = $Error::Depth + 1;
  if (exists $list->[$index]) {
    $$$self->replace_child ($_[2], $list->[$index]);
    ## ISSUE: This might not work if new_child is a sibling of ref_child
  } else {
    $$$self->append_child ($_[2]);
  }
} # STORE

sub DELETE ($$) {
  my $self = $_[0];
  my $list = ${$$$self}->{child_nodes};
  my $index = $_[1];

  if (exists $list->[$index]) {
    local $Error::Depth = $Error::Depth + 1;
    return $$$self->remove_child ($list->[$index]);
  } else {
    return undef;
  }
} # DELETE

sub CLEAR ($) {
  my $self = $_[0];
  my $list = ${$$$self}->{child_nodes};

  local $Error::Depth = $Error::Depth + 1;
  for (my @a = @$list) {
    $$$self->remove_child ($_);
  }
} # CLEAR

package Message::DOM::NodeList::EmptyNodeList;
push our @ISA, 'Message::DOM::NodeList';

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

## |NodeList| attributes

sub EXISTS ($$) { 0 }

sub length ($) { 0 }

*FETCHSIZE = \&length;

sub STORESIZE ($$) {
  report Message::DOM::DOMException
      -object => $_[0],
      -type => 'NO_MODIFICATION_ALLOWED_ERR',
      -subtype => 'READ_ONLY_NODE_LIST_ERR'
      unless $_[1] == 0;
} # STORESIZE

sub manakai_read_only ($) { 1 }

## |NodeList| methods

sub item ($$) { undef }

*FETCH = \&item;

sub STORE ($$$) {
  report Message::DOM::DOMException
      -object => $_[0],
      -type => 'NO_MODIFICATION_ALLOWED_ERR',
      -subtype => 'READ_ONLY_NODE_LIST_ERR';
} # STORE

*DELETE = \&STORE;

*CLEAR = \&STORE;

package Message::DOM::NodeList::GetElementsList;
push our @ISA, 'Message::DOM::NodeList::EmptyNodeList';

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

## |NodeList| attributes

sub length ($) {
  my $self = $_[0];
  my $r = 0;

  ## TODO: Improve!
  local $Error::Depth = $Error::Depth + 1;
  my @target = @{$$self->[0]->child_nodes};
  while (@target) {
    my $target = shift @target;
    if ($target->node_type == 1) { # ELEMENT_NODE
      if ($$self->[1]->($target)) {
        $r++;
      }
    }
    unshift @target, @{$target->child_nodes};
  }

  return $r;
} # length
*FETCHSIZE = \&length;

## |NodeList| methods

sub item ($;$) {
  my $self = $_[0];
  my $index = 0+($_[1] or 0);

  ## TODO: Improve!
  local $Error::Depth = $Error::Depth + 1;
  my @target = @{$$self->[0]->child_nodes};
  my $i = -1;
  while (@target) {
    my $target = shift @target;
    if ($target->node_type == 1) { # ELEMENT_NODE
      if ($$self->[1]->($target)) {
        if (++$i == $index) {
          return $target;
        }
      }
    }
    unshift @target, @{$target->child_nodes};
  }

  return undef;
} # item
*FETCH = \&item;

sub EXISTS ($$) {
  return defined $_[0]->item ($_[1]);
} # EXISTS

package Message::DOM::NodeList::StaticNodeList;
push our @ISA, 'Messaeg::IF::StaticNodeList';

use overload
    '==' => sub {
      ## NOTE: Same as |NodeList|'s.
      return 0 unless UNIVERSAL::isa ($_[1], 'Message::IF::NodeList');
      
      local $Error::Depth = $Error::Depth + 1;
      my $l1 = $_[0]->length;
      my $l2 = $_[1]->length;
      return 0 unless $l1 == $l2;
      
      for my $i (0 .. ($l1-1)) {
        return 0 unless $_[0]->item ($i) == $_[1]->item ($i);
      }
      
      return 1;
    },
    '!=' => sub {
      return not ($_[0] == $_[1]);
    },
    fallback => 1;

## |NodeList| attributes

sub length ($) {
  return scalar @{$_[0]};
} # length

sub manakai_read_only () { 0 }

## |NodeList| methods

sub item ($;$) {
  my $index = int ($_[1] or 0);
  return $_[0]->[$index] if $index >= 0;
} # item

package Message::IF::NodeList;

package Message::IF::StaticNodeList;
push our @ISA, 'Message::IF::NodeList';

=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/07/15 05:18:46 $
1	package Message::DOM::NodeList;
2	use strict;
3	our $VERSION=do{my @r=(q$Revision: 1.5 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
4	push our @ISA, 'Tie::Array', 'Message::IF::NodeList';
5	require Message::DOM::DOMException;
6	require Tie::Array;
7
8	use overload
9	'@{}' => sub {
10	tie my @list, ref $_[0], $_[0];
11	return \@list;
12	},
13	eq => sub {
14	return 0 unless UNIVERSAL::isa ($_[1], 'Message::DOM::NodeList');
15	return $${$_[0]} eq $${$_[1]};
16	},
17	ne => sub {
18	return not ($_[0] eq $_[1]);
19	},
20	'==' => sub {
21	## NOTE: Same as \|StaticNodeList\|'s.
22	return 0 unless UNIVERSAL::isa ($_[1], 'Message::IF::NodeList');
23
24	local $Error::Depth = $Error::Depth + 1;
25	my $l1 = $_[0]->length;
26	my $l2 = $_[1]->length;
27	return 0 unless $l1 == $l2;
28
29	for my $i (0 .. ($l1-1)) {
30	return 0 unless $_[0]->item ($i) == $_[1]->item ($i);
31	}
32
33	return 1;
34	},
35	'!=' => sub {
36	return not ($_[0] == $_[1]);
37	},
38	fallback => 1;
39
40	sub TIEARRAY ($$) { $_[1] }
41
42	package Message::DOM::NodeList::ChildNodeList;
43	push our @ISA, 'Message::DOM::NodeList';
44
45	## NOTE: \|Message::DOM::CSSRuleList\| has similar codes to this package.
46
47	sub ___report_error ($$) {
48	$_[1]->throw;
49	} # ___report_error
50
51	## \|NodeList\| attributes
52
53	sub EXISTS ($$) {
54	return exists ${$${$_[0]}}->{child_nodes}->[$_[1]];
55	} # EXISTS
56
57	sub length ($) {
58	return scalar @{${$${$_[0]}}->{child_nodes}};
59	} # length
60
61	*FETCHSIZE = \&length;
62
63	sub STORESIZE ($$) {
64	my $node = $${$_[0]};
65	my $list = $$node->{child_nodes};
66	my $current_length = @{$list};
67	my $count = $_[1];
68
69	local $Error::Depth = $Error::Depth + 1;
70	if ($current_length > $count) {
71	for (my $i = $current_length - 1; $i >= $count; $i--) {
72	$node->remove_child ($list->[$i]);
73	}
74	}
75	} # STORESIZE
76
77	sub manakai_read_only ($) {
78	local $Error::Depth = $Error::Depth + 1;
79	return $${$_[0]}->manakai_read_only;
80	} # manakai_read_only
81
82	## \|NodeList\| methods
83
84	sub item ($$) {
85	my $index = 0+$_[1];
86	return undef if $index < 0;
87	return ${$${$_[0]}}->{child_nodes}->[$index];
88	} # item
89
90	sub FETCH ($$) {
91	return ${$${$_[0]}}->{child_nodes}->[$_[1]];
92	} # FETCH
93
94	sub STORE ($$$) {
95	my $self = $_[0];
96	my $list = ${$$$self}->{child_nodes};
97	my $index = $_[1];
98
99	local $Error::Depth = $Error::Depth + 1;
100	if (exists $list->[$index]) {
101	$$$self->replace_child ($_[2], $list->[$index]);
102	## ISSUE: This might not work if new_child is a sibling of ref_child
103	} else {
104	$$$self->append_child ($_[2]);
105	}
106	} # STORE
107
108	sub DELETE ($$) {
109	my $self = $_[0];
110	my $list = ${$$$self}->{child_nodes};
111	my $index = $_[1];
112
113	if (exists $list->[$index]) {
114	local $Error::Depth = $Error::Depth + 1;
115	return $$$self->remove_child ($list->[$index]);
116	} else {
117	return undef;
118	}
119	} # DELETE
120
121	sub CLEAR ($) {
122	my $self = $_[0];
123	my $list = ${$$$self}->{child_nodes};
124
125	local $Error::Depth = $Error::Depth + 1;
126	for (my @a = @$list) {
127	$$$self->remove_child ($_);
128	}
129	} # CLEAR
130
131	package Message::DOM::NodeList::EmptyNodeList;
132	push our @ISA, 'Message::DOM::NodeList';
133
134	sub ___report_error ($$) {
135	$_[1]->throw;
136	} # ___report_error
137
138	## \|NodeList\| attributes
139
140	sub EXISTS ($$) { 0 }
141
142	sub length ($) { 0 }
143
144	*FETCHSIZE = \&length;
145
146	sub STORESIZE ($$) {
147	report Message::DOM::DOMException
148	-object => $_[0],
149	-type => 'NO_MODIFICATION_ALLOWED_ERR',
150	-subtype => 'READ_ONLY_NODE_LIST_ERR'
151	unless $_[1] == 0;
152	} # STORESIZE
153
154	sub manakai_read_only ($) { 1 }
155
156	## \|NodeList\| methods
157
158	sub item ($$) { undef }
159
160	*FETCH = \&item;
161
162	sub STORE ($$$) {
163	report Message::DOM::DOMException
164	-object => $_[0],
165	-type => 'NO_MODIFICATION_ALLOWED_ERR',
166	-subtype => 'READ_ONLY_NODE_LIST_ERR';
167	} # STORE
168
169	*DELETE = \&STORE;
170
171	*CLEAR = \&STORE;
172
173	package Message::DOM::NodeList::GetElementsList;
174	push our @ISA, 'Message::DOM::NodeList::EmptyNodeList';
175
176	sub ___report_error ($$) {
177	$_[1]->throw;
178	} # ___report_error
179
180	## \|NodeList\| attributes
181
182	sub length ($) {
183	my $self = $_[0];
184	my $r = 0;
185
186	## TODO: Improve!
187	local $Error::Depth = $Error::Depth + 1;
188	my @target = @{$$self->[0]->child_nodes};
189	while (@target) {
190	my $target = shift @target;
191	if ($target->node_type == 1) { # ELEMENT_NODE
192	if ($$self->[1]->($target)) {
193	$r++;
194	}
195	}
196	unshift @target, @{$target->child_nodes};
197	}
198
199	return $r;
200	} # length
201	*FETCHSIZE = \&length;
202
203	## \|NodeList\| methods
204
205	sub item ($;$) {
206	my $self = $_[0];
207	my $index = 0+($_[1] or 0);
208
209	## TODO: Improve!
210	local $Error::Depth = $Error::Depth + 1;
211	my @target = @{$$self->[0]->child_nodes};
212	my $i = -1;
213	while (@target) {
214	my $target = shift @target;
215	if ($target->node_type == 1) { # ELEMENT_NODE
216	if ($$self->[1]->($target)) {
217	if (++$i == $index) {
218	return $target;
219	}
220	}
221	}
222	unshift @target, @{$target->child_nodes};
223	}
224
225	return undef;
226	} # item
227	*FETCH = \&item;
228
229	sub EXISTS ($$) {
230	return defined $_[0]->item ($_[1]);
231	} # EXISTS
232
233	package Message::DOM::NodeList::StaticNodeList;
234	push our @ISA, 'Messaeg::IF::StaticNodeList';
235
236	use overload
237	'==' => sub {
238	## NOTE: Same as \|NodeList\|'s.
239	return 0 unless UNIVERSAL::isa ($_[1], 'Message::IF::NodeList');
240
241	local $Error::Depth = $Error::Depth + 1;
242	my $l1 = $_[0]->length;
243	my $l2 = $_[1]->length;
244	return 0 unless $l1 == $l2;
245
246	for my $i (0 .. ($l1-1)) {
247	return 0 unless $_[0]->item ($i) == $_[1]->item ($i);
248	}
249
250	return 1;
251	},
252	'!=' => sub {
253	return not ($_[0] == $_[1]);
254	},
255	fallback => 1;
256
257	## \|NodeList\| attributes
258
259	sub length ($) {
260	return scalar @{$_[0]};
261	} # length
262
263	sub manakai_read_only () { 0 }
264
265	## \|NodeList\| methods
266
267	sub item ($;$) {
268	my $index = int ($_[1] or 0);
269	return $_[0]->[$index] if $index >= 0;
270	} # item
271
272	package Message::IF::NodeList;
273
274	package Message::IF::StaticNodeList;
275	push our @ISA, 'Message::IF::NodeList';
276
277	=head1 LICENSE
278
279	Copyright 2007 Wakaba <[email protected]>
280
281	This program is free software; you can redistribute it and/or
282	modify it under the same terms as Perl itself.
283
284	=cut
285
286	1;
287	## $Date: 2007/07/15 05:18:46 $