Message/DOM/NamedNodeMap.pm

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

sub TIEHASH ($$) { $_[1] }

## |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;

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