655
|
1 |
######################################################################
|
|
2 |
package XML::DOM::NamedNodeMap;
|
|
3 |
######################################################################
|
|
4 |
|
|
5 |
use strict;
|
|
6 |
|
|
7 |
use Carp;
|
|
8 |
use XML::DOM::DOMException;
|
|
9 |
use XML::DOM::NodeList;
|
|
10 |
|
|
11 |
use vars qw( $Special );
|
|
12 |
|
|
13 |
# Constant definition:
|
|
14 |
# Note: a real Name should have at least 1 char, so nobody else should use this
|
|
15 |
$Special = "";
|
|
16 |
|
|
17 |
sub new
|
|
18 |
{
|
|
19 |
my ($class, %args) = @_;
|
|
20 |
|
|
21 |
$args{Values} = new XML::DOM::NodeList;
|
|
22 |
|
|
23 |
# Store all NamedNodeMap properties in element $Special
|
|
24 |
bless { $Special => \%args}, $class;
|
|
25 |
}
|
|
26 |
|
|
27 |
sub getNamedItem
|
|
28 |
{
|
|
29 |
# Don't return the $Special item!
|
|
30 |
($_[1] eq $Special) ? undef : $_[0]->{$_[1]};
|
|
31 |
}
|
|
32 |
|
|
33 |
sub setNamedItem
|
|
34 |
{
|
|
35 |
my ($self, $node) = @_;
|
|
36 |
my $prop = $self->{$Special};
|
|
37 |
|
|
38 |
my $name = $node->getNodeName;
|
|
39 |
|
|
40 |
if ($XML::DOM::SafeMode)
|
|
41 |
{
|
|
42 |
croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR)
|
|
43 |
if $self->isReadOnly;
|
|
44 |
|
|
45 |
croak new XML::DOM::DOMException (WRONG_DOCUMENT_ERR)
|
|
46 |
if $node->[XML::DOM::Node::_Doc] != $prop->{Doc};
|
|
47 |
|
|
48 |
croak new XML::DOM::DOMException (INUSE_ATTRIBUTE_ERR)
|
|
49 |
if defined ($node->[XML::DOM::Node::_UsedIn]);
|
|
50 |
|
|
51 |
croak new XML::DOM::DOMException (INVALID_CHARACTER_ERR,
|
|
52 |
"can't add name with NodeName [$name] to NamedNodeMap")
|
|
53 |
if $name eq $Special;
|
|
54 |
}
|
|
55 |
|
|
56 |
my $values = $prop->{Values};
|
|
57 |
my $index = -1;
|
|
58 |
|
|
59 |
my $prev = $self->{$name};
|
|
60 |
if (defined $prev)
|
|
61 |
{
|
|
62 |
# decouple previous node
|
|
63 |
$prev->decoupleUsedIn;
|
|
64 |
|
|
65 |
# find index of $prev
|
|
66 |
$index = 0;
|
|
67 |
for my $val (@{$values})
|
|
68 |
{
|
|
69 |
last if ($val == $prev);
|
|
70 |
$index++;
|
|
71 |
}
|
|
72 |
}
|
|
73 |
|
|
74 |
$self->{$name} = $node;
|
|
75 |
$node->[XML::DOM::Node::_UsedIn] = $self;
|
|
76 |
|
|
77 |
if ($index == -1)
|
|
78 |
{
|
|
79 |
push (@{$values}, $node);
|
|
80 |
}
|
|
81 |
else # replace previous node with new node
|
|
82 |
{
|
|
83 |
splice (@{$values}, $index, 1, $node);
|
|
84 |
}
|
|
85 |
|
|
86 |
$prev;
|
|
87 |
}
|
|
88 |
|
|
89 |
sub removeNamedItem
|
|
90 |
{
|
|
91 |
my ($self, $name) = @_;
|
|
92 |
|
|
93 |
# Be careful that user doesn't delete $Special node!
|
|
94 |
croak new XML::DOM::DOMException (NOT_FOUND_ERR)
|
|
95 |
if $name eq $Special;
|
|
96 |
|
|
97 |
my $node = $self->{$name};
|
|
98 |
|
|
99 |
croak new XML::DOM::DOMException (NOT_FOUND_ERR)
|
|
100 |
unless defined $node;
|
|
101 |
|
|
102 |
# The DOM Spec doesn't mention this Exception - I think it's an oversight
|
|
103 |
croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR)
|
|
104 |
if $self->isReadOnly;
|
|
105 |
|
|
106 |
$node->decoupleUsedIn;
|
|
107 |
delete $self->{$name};
|
|
108 |
|
|
109 |
# remove node from Values list
|
|
110 |
my $values = $self->getValues;
|
|
111 |
my $index = 0;
|
|
112 |
for my $val (@{$values})
|
|
113 |
{
|
|
114 |
if ($val == $node)
|
|
115 |
{
|
|
116 |
splice (@{$values}, $index, 1, ());
|
|
117 |
last;
|
|
118 |
}
|
|
119 |
$index++;
|
|
120 |
}
|
|
121 |
$node;
|
|
122 |
}
|
|
123 |
|
|
124 |
# The following 2 are really bogus. DOM should use an iterator instead (Clark)
|
|
125 |
|
|
126 |
sub item
|
|
127 |
{
|
|
128 |
my ($self, $item) = @_;
|
|
129 |
$self->{$Special}->{Values}->[$item];
|
|
130 |
}
|
|
131 |
|
|
132 |
sub getLength
|
|
133 |
{
|
|
134 |
my ($self) = @_;
|
|
135 |
my $vals = $self->{$Special}->{Values};
|
|
136 |
int (@$vals);
|
|
137 |
}
|
|
138 |
|
|
139 |
#------------------------------------------------------------
|
|
140 |
# Extra method implementations
|
|
141 |
|
|
142 |
sub isReadOnly
|
|
143 |
{
|
|
144 |
return 0 if $XML::DOM::IgnoreReadOnly;
|
|
145 |
|
|
146 |
my $used = $_[0]->{$Special}->{UsedIn};
|
|
147 |
defined $used ? $used->isReadOnly : 0;
|
|
148 |
}
|
|
149 |
|
|
150 |
sub cloneNode
|
|
151 |
{
|
|
152 |
my ($self, $deep) = @_;
|
|
153 |
my $prop = $self->{$Special};
|
|
154 |
|
|
155 |
my $map = new XML::DOM::NamedNodeMap (Doc => $prop->{Doc});
|
|
156 |
# Not copying Parent property on purpose!
|
|
157 |
|
|
158 |
local $XML::DOM::IgnoreReadOnly = 1; # temporarily...
|
|
159 |
|
|
160 |
for my $val (@{$prop->{Values}})
|
|
161 |
{
|
|
162 |
my $key = $val->getNodeName;
|
|
163 |
|
|
164 |
my $newNode = $val->cloneNode ($deep);
|
|
165 |
$newNode->[XML::DOM::Node::_UsedIn] = $map;
|
|
166 |
$map->{$key} = $newNode;
|
|
167 |
push (@{$map->{$Special}->{Values}}, $newNode);
|
|
168 |
}
|
|
169 |
|
|
170 |
$map;
|
|
171 |
}
|
|
172 |
|
|
173 |
sub setOwnerDocument
|
|
174 |
{
|
|
175 |
my ($self, $doc) = @_;
|
|
176 |
my $special = $self->{$Special};
|
|
177 |
|
|
178 |
$special->{Doc} = $doc;
|
|
179 |
for my $kid (@{$special->{Values}})
|
|
180 |
{
|
|
181 |
$kid->setOwnerDocument ($doc);
|
|
182 |
}
|
|
183 |
}
|
|
184 |
|
|
185 |
sub getChildIndex
|
|
186 |
{
|
|
187 |
my ($self, $attr) = @_;
|
|
188 |
my $i = 0;
|
|
189 |
for my $kid (@{$self->{$Special}->{Values}})
|
|
190 |
{
|
|
191 |
return $i if $kid == $attr;
|
|
192 |
$i++;
|
|
193 |
}
|
|
194 |
-1; # not found
|
|
195 |
}
|
|
196 |
|
|
197 |
sub getValues
|
|
198 |
{
|
|
199 |
wantarray ? @{ $_[0]->{$Special}->{Values} } : $_[0]->{$Special}->{Values};
|
|
200 |
}
|
|
201 |
|
|
202 |
# Remove circular dependencies. The NamedNodeMap and its values should
|
|
203 |
# not be used afterwards.
|
|
204 |
sub dispose
|
|
205 |
{
|
|
206 |
my $self = shift;
|
|
207 |
|
|
208 |
for my $kid (@{$self->getValues})
|
|
209 |
{
|
|
210 |
undef $kid->[XML::DOM::Node::_UsedIn]; # was delete
|
|
211 |
$kid->dispose;
|
|
212 |
}
|
|
213 |
|
|
214 |
delete $self->{$Special}->{Doc};
|
|
215 |
delete $self->{$Special}->{Parent};
|
|
216 |
delete $self->{$Special}->{Values};
|
|
217 |
|
|
218 |
for my $key (keys %$self)
|
|
219 |
{
|
|
220 |
delete $self->{$key};
|
|
221 |
}
|
|
222 |
}
|
|
223 |
|
|
224 |
sub setParentNode
|
|
225 |
{
|
|
226 |
$_[0]->{$Special}->{Parent} = $_[1];
|
|
227 |
}
|
|
228 |
|
|
229 |
sub getProperty
|
|
230 |
{
|
|
231 |
$_[0]->{$Special}->{$_[1]};
|
|
232 |
}
|
|
233 |
|
|
234 |
#?? remove after debugging
|
|
235 |
sub toString
|
|
236 |
{
|
|
237 |
my ($self) = @_;
|
|
238 |
my $str = "NamedNodeMap[";
|
|
239 |
while (my ($key, $val) = each %$self)
|
|
240 |
{
|
|
241 |
if ($key eq $Special)
|
|
242 |
{
|
|
243 |
$str .= "##Special (";
|
|
244 |
while (my ($k, $v) = each %$val)
|
|
245 |
{
|
|
246 |
if ($k eq "Values")
|
|
247 |
{
|
|
248 |
$str .= $k . " => [";
|
|
249 |
for my $a (@$v)
|
|
250 |
{
|
|
251 |
# $str .= $a->getNodeName . "=" . $a . ",";
|
|
252 |
$str .= $a->toString . ",";
|
|
253 |
}
|
|
254 |
$str .= "], ";
|
|
255 |
}
|
|
256 |
else
|
|
257 |
{
|
|
258 |
$str .= $k . " => " . $v . ", ";
|
|
259 |
}
|
|
260 |
}
|
|
261 |
$str .= "), ";
|
|
262 |
}
|
|
263 |
else
|
|
264 |
{
|
|
265 |
$str .= $key . " => " . $val . ", ";
|
|
266 |
}
|
|
267 |
}
|
|
268 |
$str . "]";
|
|
269 |
}
|
|
270 |
|
|
271 |
1; # package return code
|