Message/DOM/NamedNodeMap.pm

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

use overload
    '@{}' => sub {
      tie my @list, (ref $_[0]) . '::Array', $_[0];
      return \@list;
    },
    '%{}' => sub {
      tie my %list, ref $_[0], $_[0];
      return \%list;
    },
    eq => sub {
      return 0 unless UNIVERSAL::isa ($_[1], 'Message::DOM::NamedNodeMap');
      return 0 if $_[1]->isa ('Message::DOM::NamedNodeMap::ArrayMap');
      return (${$_[0]}->[0] eq ${$_[1]}->[0] and ${$_[0]}->[1] eq ${$_[1]}->[1]);
    },
    ne => sub {
      return not ($_[0] eq $_[1]);
    },
    '==' => sub {
      return 0 unless UNIVERSAL::isa ($_[1], 'Message::IF::NamedNodeMap');
      
      local $Error::Depth = $Error::Depth + 1;
      my $length1 = @{$_[0]};
      my $length2 = @{$_[1]};
      return 0 if $length1 != $length2;

      for my $i (0..($length1 - 1)) {
        my $node1 = $_[0]->[$i];
        my $node2 = $_[1]->[$i];
        return 0 if $node1 != $node2;
      }
      ## TODO: This ordering is only assumed in manakai...

      return 1;
    },
    '!=' => sub {
      return not ($_[0] == $_[1]);
    },
    fallback => 1;

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

## |NamedNodeMap| attributes

sub length ($) {
  return scalar @{[map {$_} values %{${${$_[0]}->[0]}->{${$_[0]}->[1]}}]};
} # length

sub manakai_read_only ($) {
  return ${${$_[0]}->[0]}->{manakai_read_only};
} # manakai_read_only

## |NamedNodeMap| methods

sub get_named_item ($$) {
  return ${${$_[0]}->[0]}->{${$_[0]}->[1]}->{$_[1]};
} # get_named_item
*FETCH = \&get_named_item;

sub get_named_item_ns ($$$) { }

sub item ($$) {
  my $index = 0+$_[1];
  my $list = ${${$_[0]}->[0]}->{${$_[0]}->[1]};

  my $key = $index >= 0 ? [sort {$a cmp $b} keys %$list]->[$index] : undef;
  if (defined $key and defined $list->{$key}) {
    return $list->{$key};
  } else {
    return undef;
  }
} # item

sub remove_named_item ($$) {
  my $name = ''.$_[1];
  my $list = ${${$_[0]}->[0]}->{${$_[0]}->[1]};

  my $od = ${${$_[0]}->[0]}->{owner_document}; # might be undef, but no problem

  my $key = ${$_[0]}->[1] eq 'attribute_definitions'
      ? 'owner_element_type_definition' : 'owner_document_type_definition';

  if ($$od->{strict_error_checking}) {
    if (${${$_[0]}->[0]}->{manakai_read_only}) {
      report Message::DOM::DOMException
          -object => $_[0],
          -type => 'NO_MODIFICATION_ALLOWED_ERR',
          -subtype => 'READ_ONLY_NODE_ERR';
    }
  }

  if (defined $list->{$name}) {
    my $r = $list->{$name};
    delete $$r->{$key};
    delete $list->{$name};
    return $r;
  } else {
    report Message::DOM::DOMException
        -object => $_[0],
        -type => 'NOT_FOUND_ERR',
        -subtype => 'NOT_CHILD_ERR';
  }
} # remove_named_item

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

sub DELETE ($$) {
  my $r;
  try {
    $r = $_[0]->remove_named_item ($_[1]);
  } catch Message::DOM::DOMException with {
    my $err = shift;
    unless ($err->subtype eq 'NOT_CHILD_ERR') {
      $err->throw;
    }
  };
  return $r; ## TODO: This return value is ok?
} # DELETE

sub set_named_item ($$) {
  my $od = ${${$_[0]}->[0]}->{owner_document};
  if (not defined $od or
      $od ne ($_[1]->owner_document || $_[1])) {
    ## TODO: $od not defined case is manakai extension.  Document it!
    report Message::DOM::DOMException
        -object => $_[0],
        -type => 'WRONG_DOCUMENT_ERR',
        -subtype => 'EXTERNAL_OBJECT_ERR';
  }

  my $key = ${$_[0]}->[1] eq 'attribute_definitions'
      ? 'owner_element_type_definition' : 'owner_document_type_definition';

  if ($$od->{strict_error_checking}) {
    if ($_[1]->node_type !=
        {
         element_types => 81001, # ELEMENT_TYPE_DEFINITION_NODE
         attribute_definitions => 81002, # ATTRIBUTE_DEFINITION_NODE
         entities => 6, # ENTITY_NODE
         notations => 12, # NOTATION_NODE
        }->{${$_[0]}->[1]}) {
      report Message::DOM::DOMException
          -object => $_[0],
          -type => 'HIERARCHY_REQUEST_ERR',
          -subtype => 'CHILD_NODE_TYPE_ERR';
    }

    if (${${$_[0]}->[0]}->{manakai_read_only}) {
      report Message::DOM::DOMException
          -object => $_[0],
          -type => 'NO_MODIFICATION_ALLOWED_ERR',
          -subtype => 'READ_ONLY_NODE_ERR';
    }

    if (${$_[1]}->{$key} and not ${$_[1]}->{$key} eq ${$_[0]}->[0]) {
      ## TODO: This is manakai extension.  Document it!
      report Message::DOM::DOMException
          -object => $_[0],
          -type => 'HIERARCHY_REQUEST_ERR',
          -subtype => 'INUSE_DEFINITION_ERR';
    }
  }

  my $name = $_[1]->node_name;
  my $list = ${${$_[0]}->[0]}->{${$_[0]}->[1]};
  if (defined $list->{$name}) {
    my $r = $list->{$name};
    if ($r eq $_[1]) {
      ## NOTE: Replace by itself (implementation dependent).
      return undef;
    } else {
      $list->{$name} = $_[1];
      ${$_[1]}->{$key} = ${$_[0]}->[0];
      Scalar::Util::weaken (${$_[1]}->{$key});
      delete $$r->{$key};
      return $r;
    }
  } else {
    $list->{$name} = $_[1];
    ${$_[1]}->{$key} = ${$_[0]}->[0];
    Scalar::Util::weaken (${$_[1]}->{$key});
    return undef;
  }
} # set_named_item

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

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

sub FIRSTKEY ($) {
  my $list = ${${$_[0]}->[0]}->{${$_[0]}->[1]};
  my $a = keys %$list; # reset
  return each %$list;
} # FIRSTKEY

sub NEXTKEY ($) {
  return each %{${${$_[0]}->[0]}->{${$_[0]}->[1]}};
} # NEXTKEY

sub SCALAR ($) {
  return scalar %{${${$_[0]}->[0]}->{${$_[0]}->[1]}};
} # SCALAR

package Message::DOM::NamedNodeMap::Array;
push our @ISA, 'Tie::Array';

sub DELETE ($$) {
  my $item = $_[0]->item ($_[1]);
  if ($item) {
    local $Error::Depth = $Error::Depth + 1;
    return $_[0]->remove_named_item ($item->node_name);
  } else {
    return undef;
  }
} # DELETE

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

*FETCH = \&Message::DOM::NamedNodeMap::item;

*FETCHSIZE = \&Message::DOM::NamedNodeMap::length;

## TODO: |STORE|

sub STORESIZE ($) {
  local $Error::Depth = $Error::Depth + 1;
  my $length = $_[0]->length;
  if ($length > $_[1]) {
    for (my $i = $length - 1; $i >= $_[1]; $i--) {
      my $item = $_[0]->item ($i);
      $_[0]->remove_named_item ($item->node_name);
    }
  }
} # STORESIZE

sub TIEARRAY ($$) { bless \[${$_[1]}->[0], ${$_[1]}->[1]], __PACKAGE__ }

package Message::DOM::NamedNodeMap::AttrMap;
push our @ISA, 'Message::DOM::NamedNodeMap';

use overload
    eq => sub {
      return 0 unless UNIVERSAL::isa ($_[1], 'Message::DOM::NamedNodeMap');
      return $${$_[0]} eq $${$_[1]};
    },
    fallback => 1;

## |NamedNodeMap| attributes

sub length ($) {
  my $list = ${$${$_[0]}}->{manakai_content_attribute_list};
  if (defined $list) {
    return scalar @$list;
  } else {
    $list = ${$${$_[0]}}->{attributes};
    my $r = 0;
    for my $l (values %$list) {
      $r += grep {$l->{$_}} keys %$l;
    }
    return $r;
  }
} # length

sub manakai_read_only ($) {
  return ${$${$_[0]}}->{manakai_read_only};
} # manakai_read_only

## |NamedNodeMap| methods

sub get_named_item ($$) {
  local $Error::Depth = $Error::Depth + 1;
  return $${$_[0]}->get_attribute_node ($_[1]);
} # get_named_item
*FETCH = \&get_named_item;

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

sub item ($$) {
  ## Update the sorted content attribute name list
  my $list = ${$${$_[0]}}->{manakai_content_attribute_list};
  my $attrs = ${$${$_[0]}}->{attributes};
  unless (defined $list) {
    $list = [];
    for my $ns (sort {$a cmp $b} keys %{$attrs}) {
      push @$list, map {[$ns => $_]} sort {$a cmp $b} keys %{$attrs->{$ns}};
    }
    ${$${$_[0]}}->{manakai_content_attribute_list} = $list;
  }

  my $index = 0+$_[1];
  return $attrs->{$list->[$index]->[0]}->{$list->[$index]->[1]};
} # item

sub remove_named_item ($$) {
  my $el = $${$_[0]};
  local $Error::Depth = $Error::Depth + 1;
  my $node = $el->get_attribute_node ($_[1]);
  unless ($node) {
    local $Error::Depth = $Error::Depth - 1;
    report Message::DOM::DOMException
        -object => $_[0],
        -type => 'NOT_FOUND_ERR',
        -subtype => 'NOT_CHILD_ERR';
  }
  return $el->remove_attribute_node ($node);
} # remove_named_item

sub remove_named_item_ns ($$) {
  my $el = $${$_[0]};
  local $Error::Depth = $Error::Depth + 1;
  my $node = $el->get_attribute_node_ns ($_[1], $_[2]);
  unless ($node) {
    local $Error::Depth = $Error::Depth - 1;
    report Message::DOM::DOMException
        -object => $_[0],
        -type => 'NOT_FOUND_ERR',
        -subtype => 'NOT_CHILD_ERR';
  }
  return $el->remove_attribute_node ($node);
} # remove_named_item_ns

sub set_named_item ($$) {
  if ($_[1]->node_type != 2) { # ATTRIBUTE_NODE
    report Message::DOM::DOMException
        -object => $_[0],
        -type => 'HIERARCHY_REQUEST_ERR',
        -subtype => 'CHILD_NODE_TYPE_ERR';
  }

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

sub set_named_item_ns ($$) {
  if ($_[1]->node_type != 2) { # ATTRIBUTE_NODE
    report Message::DOM::DOMException
        -object => $_[0],
        -type => 'HIERARCHY_REQUEST_ERR',
        -subtype => 'CHILD_NODE_TYPE_ERR';
  }

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

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

sub FIRSTKEY ($) {
  local $Error::Depth = $Error::Depth + 1;
  my $node = $_[0]->item (0);
  ${$${$_[0]}}->{manakai_hash_position} = 1;
  return $node ? $node->node_name : undef;
} # FIRSTKEY

sub NEXTKEY ($) {
  my $i = ${$${$_[0]}}->{manakai_hash_position}++;
  my $node = $_[0]->item ($i);
  return $node ? $node->node_name : undef;
} # NEXTKEY

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

package Message::DOM::NamedNodeMap::AttrMap::Array;
push our @ISA, 'Tie::Array';

sub DELETE ($$) {
  my $item = $_[0]->item ($_[1]);
  if ($item) {
    local $Error::Depth = $Error::Depth + 1;
    return $_[0]->remove_named_item_ns
        ($item->namespace_uri, $item->manakai_local_name);
  } else {
    return undef;
  }
} # DELETE

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

*FETCH = \&Message::DOM::NamedNodeMap::AttrMap::item;

*FETCHSIZE = \&Message::DOM::NamedNodeMap::AttrMap::length;

sub STORESIZE ($) {
  local $Error::Depth = $Error::Depth + 1;
  my $length = $_[0]->length;
  if ($length > $_[1]) {
    for (my $i = $length - 1; $i >= $_[1]; $i--) {
      my $item = $_[0]->item ($i);
      $_[0]->remove_named_item_ns
          ($item->namespace_uri, $item->manakai_local_name);
    }
  }
} # STORESIZE

sub TIEARRAY ($$) { bless \\$${$_[1]}, __PACKAGE__ }

package Message::IF::NamedNodeMap;

=head1 LICENSE

Copyright 2007 Wakaba <w@suika.fam.cx>

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/17 13:37:40 $
1	wakaba	1.1	package Message::DOM::NamedNodeMap;
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::NamedNodeMap';
5			require Message::DOM::DOMException;
6			require Tie::Array;
7
8			use overload
9			'@{}' => sub {
10			tie my @list, (ref $_[0]) . '::Array', $_[0];
11			return \@list;
12			},
13			'%{}' => sub {
14			tie my %list, ref $_[0], $_[0];
15			return \%list;
16			},
17			eq => sub {
18			return 0 unless UNIVERSAL::isa ($_[1], 'Message::DOM::NamedNodeMap');
19			return 0 if $_[1]->isa ('Message::DOM::NamedNodeMap::ArrayMap');
20			return (${$_[0]}->[0] eq ${$_[1]}->[0] and ${$_[0]}->[1] eq ${$_[1]}->[1]);
21			},
22			ne => sub {
23			return not ($_[0] eq $_[1]);
24			},
25			'==' => sub {
26			return 0 unless UNIVERSAL::isa ($_[1], 'Message::IF::NamedNodeMap');
27
28			local $Error::Depth = $Error::Depth + 1;
29			my $length1 = @{$_[0]};
30			my $length2 = @{$_[1]};
31			return 0 if $length1 != $length2;
32
33			for my $i (0..($length1 - 1)) {
34			my $node1 = $_[0]->[$i];
35			my $node2 = $_[1]->[$i];
36			return 0 if $node1 != $node2;
37			}
38			## TODO: This ordering is only assumed in manakai...
39
40			return 1;
41			},
42			'!=' => sub {
43			return not ($_[0] == $_[1]);
44			},
45			fallback => 1;
46
47			sub ___report_error ($$) {
48			$_[1]->throw;
49			} # ___report_error
50
51			## \|NamedNodeMap\| attributes
52
53			sub length ($) {
54			return scalar @{[map {$_} values %{${${$_[0]}->[0]}->{${$_[0]}->[1]}}]};
55			} # length
56
57			sub manakai_read_only ($) {
58			return ${${$_[0]}->[0]}->{manakai_read_only};
59			} # manakai_read_only
60
61			## \|NamedNodeMap\| methods
62
63			sub get_named_item ($$) {
64			return ${${$_[0]}->[0]}->{${$_[0]}->[1]}->{$_[1]};
65			} # get_named_item
66			*FETCH = \&get_named_item;
67
68			sub get_named_item_ns ($$$) { }
69
70			sub item ($$) {
71			my $index = 0+$_[1];
72			my $list = ${${$_[0]}->[0]}->{${$_[0]}->[1]};
73
74			my $key = $index >= 0 ? [sort {$a cmp $b} keys %$list]->[$index] : undef;
75			if (defined $key and defined $list->{$key}) {
76			return $list->{$key};
77			} else {
78			return undef;
79			}
80			} # item
81
82			sub remove_named_item ($$) {
83			my $name = ''.$_[1];
84			my $list = ${${$_[0]}->[0]}->{${$_[0]}->[1]};
85
86			my $od = ${${$_[0]}->[0]}->{owner_document}; # might be undef, but no problem
87
88			my $key = ${$_[0]}->[1] eq 'attribute_definitions'
89			? 'owner_element_type_definition' : 'owner_document_type_definition';
90
91			if ($$od->{strict_error_checking}) {
92			if (${${$_[0]}->[0]}->{manakai_read_only}) {
93			report Message::DOM::DOMException
94			-object => $_[0],
95			-type => 'NO_MODIFICATION_ALLOWED_ERR',
96			-subtype => 'READ_ONLY_NODE_ERR';
97			}
98			}
99
100			if (defined $list->{$name}) {
101			my $r = $list->{$name};
102			delete $$r->{$key};
103			delete $list->{$name};
104			return $r;
105			} else {
106			report Message::DOM::DOMException
107			-object => $_[0],
108			-type => 'NOT_FOUND_ERR',
109			-subtype => 'NOT_CHILD_ERR';
110			}
111			} # remove_named_item
112
113			sub remove_named_item_ns ($$) {
114			report Message::DOM::DOMException
115			-object => $_[0],
116			-type => 'NOT_FOUND_ERR',
117			-subtype => 'NOT_CHILD_ERR';
118			} # remove_named_item_ns
119
120			sub DELETE ($$) {
121			my $r;
122			try {
123			$r = $_[0]->remove_named_item ($_[1]);
124			} catch Message::DOM::DOMException with {
125			my $err = shift;
126			unless ($err->subtype eq 'NOT_CHILD_ERR') {
127			$err->throw;
128			}
129			};
130			return $r; ## TODO: This return value is ok?
131			} # DELETE
132
133			sub set_named_item ($$) {
134			my $od = ${${$_[0]}->[0]}->{owner_document};
135			if (not defined $od or
136			$od ne ($_[1]->owner_document \|\| $_[1])) {
137			## TODO: $od not defined case is manakai extension. Document it!
138			report Message::DOM::DOMException
139			-object => $_[0],
140			-type => 'WRONG_DOCUMENT_ERR',
141			-subtype => 'EXTERNAL_OBJECT_ERR';
142			}
143
144			my $key = ${$_[0]}->[1] eq 'attribute_definitions'
145			? 'owner_element_type_definition' : 'owner_document_type_definition';
146
147			if ($$od->{strict_error_checking}) {
148			if ($_[1]->node_type !=
149			{
150			element_types => 81001, # ELEMENT_TYPE_DEFINITION_NODE
151			attribute_definitions => 81002, # ATTRIBUTE_DEFINITION_NODE
152			entities => 6, # ENTITY_NODE
153			notations => 12, # NOTATION_NODE
154			}->{${$_[0]}->[1]}) {
155			report Message::DOM::DOMException
156			-object => $_[0],
157			-type => 'HIERARCHY_REQUEST_ERR',
158			-subtype => 'CHILD_NODE_TYPE_ERR';
159			}
160
161			if (${${$_[0]}->[0]}->{manakai_read_only}) {
162			report Message::DOM::DOMException
163			-object => $_[0],
164			-type => 'NO_MODIFICATION_ALLOWED_ERR',
165			-subtype => 'READ_ONLY_NODE_ERR';
166			}
167
168			if (${$_[1]}->{$key} and not ${$_[1]}->{$key} eq ${$_[0]}->[0]) {
169			## TODO: This is manakai extension. Document it!
170			report Message::DOM::DOMException
171			-object => $_[0],
172			-type => 'HIERARCHY_REQUEST_ERR',
173			-subtype => 'INUSE_DEFINITION_ERR';
174			}
175			}
176
177			my $name = $_[1]->node_name;
178			my $list = ${${$_[0]}->[0]}->{${$_[0]}->[1]};
179			if (defined $list->{$name}) {
180			my $r = $list->{$name};
181			if ($r eq $_[1]) {
182			## NOTE: Replace by itself (implementation dependent).
183			return undef;
184			} else {
185			$list->{$name} = $_[1];
186			${$_[1]}->{$key} = ${$_[0]}->[0];
187			Scalar::Util::weaken (${$_[1]}->{$key});
188			delete $$r->{$key};
189			return $r;
190			}
191			} else {
192			$list->{$name} = $_[1];
193			${$_[1]}->{$key} = ${$_[0]}->[0];
194			Scalar::Util::weaken (${$_[1]}->{$key});
195			return undef;
196			}
197			} # set_named_item
198
199			sub set_named_item_ns ($$) {
200			report Message::DOM::DOMException
201			-object => $_[0],
202			-type => 'HIERARCHY_REQUEST_ERR',
203			-subtype => 'CHILD_NODE_TYPE_ERR';
204			} # set_named_item_ns
205
206			sub EXISTS ($$) {
207			return exists ${${$_[0]}->[0]}->{${$_[0]}->[1]}->{$_[1]};
208			} # EXISTS
209
210			sub FIRSTKEY ($) {
211			my $list = ${${$_[0]}->[0]}->{${$_[0]}->[1]};
212			my $a = keys %$list; # reset
213			return each %$list;
214			} # FIRSTKEY
215
216			sub NEXTKEY ($) {
217			return each %{${${$_[0]}->[0]}->{${$_[0]}->[1]}};
218			} # NEXTKEY
219
220			sub SCALAR ($) {
221			return scalar %{${${$_[0]}->[0]}->{${$_[0]}->[1]}};
222			} # SCALAR
223
224			package Message::DOM::NamedNodeMap::Array;
225			push our @ISA, 'Tie::Array';
226
227			sub DELETE ($$) {
228			my $item = $_[0]->item ($_[1]);
229			if ($item) {
230			local $Error::Depth = $Error::Depth + 1;
231			return $_[0]->remove_named_item ($item->node_name);
232			} else {
233			return undef;
234			}
235			} # DELETE
236
237			sub EXISTS ($$) {
238			return ($_[1] < $_[0]->length);
239			} # EXISTS
240
241			*FETCH = \&Message::DOM::NamedNodeMap::item;
242
243			*FETCHSIZE = \&Message::DOM::NamedNodeMap::length;
244
245			## TODO: \|STORE\|
246
247			sub STORESIZE ($) {
248			local $Error::Depth = $Error::Depth + 1;
249			my $length = $_[0]->length;
250			if ($length > $_[1]) {
251			for (my $i = $length - 1; $i >= $_[1]; $i--) {
252			my $item = $_[0]->item ($i);
253			$_[0]->remove_named_item ($item->node_name);
254			}
255			}
256			} # STORESIZE
257
258			sub TIEARRAY ($$) { bless \[${$_[1]}->[0], ${$_[1]}->[1]], __PACKAGE__ }
259
260			package Message::DOM::NamedNodeMap::AttrMap;
261			push our @ISA, 'Message::DOM::NamedNodeMap';
262
263			use overload
264			eq => sub {
265			return 0 unless UNIVERSAL::isa ($_[1], 'Message::DOM::NamedNodeMap');
266			return $${$_[0]} eq $${$_[1]};
267			},
268			fallback => 1;
269
270			## \|NamedNodeMap\| attributes
271
272			sub length ($) {
273			my $list = ${$${$_[0]}}->{manakai_content_attribute_list};
274			if (defined $list) {
275			return scalar @$list;
276			} else {
277			$list = ${$${$_[0]}}->{attributes};
278			my $r = 0;
279			for my $l (values %$list) {
280			$r += grep {$l->{$_}} keys %$l;
281			}
282			return $r;
283			}
284			} # length
285
286			sub manakai_read_only ($) {
287			return ${$${$_[0]}}->{manakai_read_only};
288			} # manakai_read_only
289
290			## \|NamedNodeMap\| methods
291
292			sub get_named_item ($$) {
293			local $Error::Depth = $Error::Depth + 1;
294			return $${$_[0]}->get_attribute_node ($_[1]);
295			} # get_named_item
296			*FETCH = \&get_named_item;
297
298			sub get_named_item_ns ($$$) {
299			local $Error::Depth = $Error::Depth + 1;
300			return $${$_[0]}->get_attribute_node_ns ($_[1], $_[2]);
301			} # get_named_item_ns
302
303			sub item ($$) {
304			## Update the sorted content attribute name list
305			my $list = ${$${$_[0]}}->{manakai_content_attribute_list};
306			my $attrs = ${$${$_[0]}}->{attributes};
307			unless (defined $list) {
308			$list = [];
309			for my $ns (sort {$a cmp $b} keys %{$attrs}) {
310			push @$list, map {[$ns => $_]} sort {$a cmp $b} keys %{$attrs->{$ns}};
311			}
312			${$${$_[0]}}->{manakai_content_attribute_list} = $list;
313			}
314
315			my $index = 0+$_[1];
316			return $attrs->{$list->[$index]->[0]}->{$list->[$index]->[1]};
317			} # item
318
319			sub remove_named_item ($$) {
320			my $el = $${$_[0]};
321			local $Error::Depth = $Error::Depth + 1;
322			my $node = $el->get_attribute_node ($_[1]);
323			unless ($node) {
324			local $Error::Depth = $Error::Depth - 1;
325			report Message::DOM::DOMException
326			-object => $_[0],
327			-type => 'NOT_FOUND_ERR',
328			-subtype => 'NOT_CHILD_ERR';
329			}
330			return $el->remove_attribute_node ($node);
331			} # remove_named_item
332
333			sub remove_named_item_ns ($$) {
334			my $el = $${$_[0]};
335			local $Error::Depth = $Error::Depth + 1;
336			my $node = $el->get_attribute_node_ns ($_[1], $_[2]);
337			unless ($node) {
338			local $Error::Depth = $Error::Depth - 1;
339			report Message::DOM::DOMException
340			-object => $_[0],
341			-type => 'NOT_FOUND_ERR',
342			-subtype => 'NOT_CHILD_ERR';
343			}
344			return $el->remove_attribute_node ($node);
345			} # remove_named_item_ns
346
347			sub set_named_item ($$) {
348			if ($_[1]->node_type != 2) { # ATTRIBUTE_NODE
349			report Message::DOM::DOMException
350			-object => $_[0],
351			-type => 'HIERARCHY_REQUEST_ERR',
352			-subtype => 'CHILD_NODE_TYPE_ERR';
353			}
354
355			local $Error::Depth = $Error::Depth + 1;
356			return $${$_[0]}->set_attribute_node ($_[1]);
357			} # set_named_item
358
359			sub set_named_item_ns ($$) {
360			if ($_[1]->node_type != 2) { # ATTRIBUTE_NODE
361			report Message::DOM::DOMException
362			-object => $_[0],
363			-type => 'HIERARCHY_REQUEST_ERR',
364			-subtype => 'CHILD_NODE_TYPE_ERR';
365			}
366
367			local $Error::Depth = $Error::Depth + 1;
368			return $${$_[0]}->set_attribute_node_ns ($_[1]);
369			} # set_named_item_ns
370
371			sub EXISTS ($$) {
372			local $Error::Depth = $Error::Depth + 1;
373			return defined ($_[0]->get_named_item ($_[1]));
374			} # EXISTS
375
376			sub FIRSTKEY ($) {
377			local $Error::Depth = $Error::Depth + 1;
378			my $node = $_[0]->item (0);
379			${$${$_[0]}}->{manakai_hash_position} = 1;
380			return $node ? $node->node_name : undef;
381			} # FIRSTKEY
382
383			sub NEXTKEY ($) {
384			my $i = ${$${$_[0]}}->{manakai_hash_position}++;
385			my $node = $_[0]->item ($i);
386			return $node ? $node->node_name : undef;
387			} # NEXTKEY
388
389			sub SCALAR ($) {
390			local $Error::Depth = $Error::Depth + 1;
391			return $${$_[0]}->has_attributes;
392			} # SCALAR
393
394			package Message::DOM::NamedNodeMap::AttrMap::Array;
395			push our @ISA, 'Tie::Array';
396
397			sub DELETE ($$) {
398			my $item = $_[0]->item ($_[1]);
399			if ($item) {
400			local $Error::Depth = $Error::Depth + 1;
401			return $_[0]->remove_named_item_ns
402			($item->namespace_uri, $item->manakai_local_name);
403			} else {
404			return undef;
405			}
406			} # DELETE
407
408			sub EXISTS ($$) {
409			return ($_[1] < $_[0]->length);
410			} # EXISTS
411
412			*FETCH = \&Message::DOM::NamedNodeMap::AttrMap::item;
413
414			*FETCHSIZE = \&Message::DOM::NamedNodeMap::AttrMap::length;
415
416			sub STORESIZE ($) {
417			local $Error::Depth = $Error::Depth + 1;
418			my $length = $_[0]->length;
419			if ($length > $_[1]) {
420			for (my $i = $length - 1; $i >= $_[1]; $i--) {
421			my $item = $_[0]->item ($i);
422			$_[0]->remove_named_item_ns
423			($item->namespace_uri, $item->manakai_local_name);
424			}
425			}
426			} # STORESIZE
427
428			sub TIEARRAY ($$) { bless \\$${$_[1]}, __PACKAGE__ }
429
430			package Message::IF::NamedNodeMap;
431
432			=head1 LICENSE
433
434			Copyright 2007 Wakaba <w@suika.fam.cx>
435
436			This program is free software; you can redistribute it and/or
437			modify it under the same terms as Perl itself.
438
439			=cut
440
441			1;
442			## $Date: 2007/06/17 13:37:40 $