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	wakaba	1.1	package Message::DOM::NodeList;
2			use strict;
3	wakaba	1.6	our $VERSION=do{my @r=(q$Revision: 1.5 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
4	wakaba	1.2	push our @ISA, 'Tie::Array', 'Message::IF::NodeList';
5	wakaba	1.1	require Message::DOM::DOMException;
6	wakaba	1.2	require Tie::Array;
7	wakaba	1.1
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	wakaba	1.5	## NOTE: Same as \|StaticNodeList\|'s.
22	wakaba	1.1	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	wakaba	1.6	## NOTE: \|Message::DOM::CSSRuleList\| has similar codes to this package.
46
47	wakaba	1.1	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	wakaba	1.3	## ISSUE: This might not work if new_child is a sibling of ref_child
103	wakaba	1.1	} 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	wakaba	1.2	for (my @a = @$list) {
127	wakaba	1.1	$$$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	wakaba	1.4	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	wakaba	1.5	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	wakaba	1.1	package Message::IF::NodeList;
273
274	wakaba	1.5	package Message::IF::StaticNodeList;
275			push our @ISA, 'Message::IF::NodeList';
276
277	wakaba	1.1	=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	wakaba	1.6	## $Date: 2007/07/15 05:18:46 $