Message/DOM/NodeList.pm

package Message::DOM::NodeList;
use strict;
our $VERSION=do{my @r=(q$Revision: 1.4 $=~/\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';

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