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