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	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 $