Message/DOM/NodeList.pm

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

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 {
      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]);
  } 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 (@$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::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/06/15 16:12:28 $
1	wakaba	1.1	package Message::DOM::NodeList;
2			use strict;
3			our $VERSION=do{my @r=(q$Revision: 1.3 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
4			push our @ISA, 'Message::IF::NodeList';
5			require Message::DOM::DOMException;
6
7			use overload
8			'@{}' => sub {
9			tie my @list, ref $_[0], $_[0];
10			return \@list;
11			},
12			eq => sub {
13			return 0 unless UNIVERSAL::isa ($_[1], 'Message::DOM::NodeList');
14			return $${$_[0]} eq $${$_[1]};
15			},
16			ne => sub {
17			return not ($_[0] eq $_[1]);
18			},
19			'==' => sub {
20			return 0 unless UNIVERSAL::isa ($_[1], 'Message::IF::NodeList');
21
22			local $Error::Depth = $Error::Depth + 1;
23			my $l1 = $_[0]->length;
24			my $l2 = $_[1]->length;
25			return 0 unless $l1 == $l2;
26
27			for my $i (0 .. ($l1-1)) {
28			return 0 unless $_[0]->item ($i) == $_[1]->item ($i);
29			}
30
31			return 1;
32			},
33			'!=' => sub {
34			return not ($_[0] == $_[1]);
35			},
36			fallback => 1;
37
38			sub TIEARRAY ($$) { $_[1] }
39
40			package Message::DOM::NodeList::ChildNodeList;
41			push our @ISA, 'Message::DOM::NodeList';
42
43			sub ___report_error ($$) {
44			$_[1]->throw;
45			} # ___report_error
46
47			## \|NodeList\| attributes
48
49			sub EXISTS ($$) {
50			return exists ${$${$_[0]}}->{child_nodes}->[$_[1]];
51			} # EXISTS
52
53			sub length ($) {
54			return scalar @{${$${$_[0]}}->{child_nodes}};
55			} # length
56
57			*FETCHSIZE = \&length;
58
59			sub STORESIZE ($$) {
60			my $node = $${$_[0]};
61			my $list = $$node->{child_nodes};
62			my $current_length = @{$list};
63			my $count = $_[1];
64
65			local $Error::Depth = $Error::Depth + 1;
66			if ($current_length > $count) {
67			for (my $i = $current_length - 1; $i >= $count; $i--) {
68			$node->remove_child ($list->[$i]);
69			}
70			}
71			} # STORESIZE
72
73			sub manakai_read_only ($) {
74			local $Error::Depth = $Error::Depth + 1;
75			return $${$_[0]}->manakai_read_only;
76			} # manakai_read_only
77
78			## \|NodeList\| methods
79
80			sub item ($$) {
81			my $index = 0+$_[1];
82			return undef if $index < 0;
83			return ${$${$_[0]}}->{child_nodes}->[$index];
84			} # item
85
86			sub FETCH ($$) {
87			return ${$${$_[0]}}->{child_nodes}->[$_[1]];
88			} # FETCH
89
90			sub STORE ($$$) {
91			my $self = $_[0];
92			my $list = ${$$$self}->{child_nodes};
93			my $index = $_[1];
94
95			local $Error::Depth = $Error::Depth + 1;
96			if (exists $list->[$index]) {
97			$$$self->replace_child ($_[2], $list->[$index]);
98			} else {
99			$$$self->append_child ($_[2]);
100			}
101			} # STORE
102
103			sub DELETE ($$) {
104			my $self = $_[0];
105			my $list = ${$$$self}->{child_nodes};
106			my $index = $_[1];
107
108			if (exists $list->[$index]) {
109			local $Error::Depth = $Error::Depth + 1;
110			return $$$self->remove_child ($list->[$index]);
111			} else {
112			return undef;
113			}
114			} # DELETE
115
116			sub CLEAR ($) {
117			my $self = $_[0];
118			my $list = ${$$$self}->{child_nodes};
119
120			local $Error::Depth = $Error::Depth + 1;
121			for (@$list) {
122			$$$self->remove_child ($_);
123			}
124			} # CLEAR
125
126			package Message::DOM::NodeList::EmptyNodeList;
127			push our @ISA, 'Message::DOM::NodeList';
128
129			sub ___report_error ($$) {
130			$_[1]->throw;
131			} # ___report_error
132
133			## \|NodeList\| attributes
134
135			sub EXISTS ($$) { 0 }
136
137			sub length ($) { 0 }
138
139			*FETCHSIZE = \&length;
140
141			sub STORESIZE ($$) {
142			report Message::DOM::DOMException
143			-object => $_[0],
144			-type => 'NO_MODIFICATION_ALLOWED_ERR',
145			-subtype => 'READ_ONLY_NODE_LIST_ERR'
146			unless $_[1] == 0;
147			} # STORESIZE
148
149			sub manakai_read_only ($) { 1 }
150
151			## \|NodeList\| methods
152
153			sub item ($$) { undef }
154
155			*FETCH = \&item;
156
157			sub STORE ($$$) {
158			report Message::DOM::DOMException
159			-object => $_[0],
160			-type => 'NO_MODIFICATION_ALLOWED_ERR',
161			-subtype => 'READ_ONLY_NODE_LIST_ERR';
162			} # STORE
163
164			*DELETE = \&STORE;
165
166			*CLEAR = \&STORE;
167
168			package Message::IF::NodeList;
169
170			=head1 LICENSE
171
172			Copyright 2007 Wakaba <[email protected]>
173
174			This program is free software; you can redistribute it and/or
175			modify it under the same terms as Perl itself.
176
177			=cut
178
179			1;
180			## $Date: 2007/06/15 16:12:28 $