/[suikacvs]/messaging/manakai/lib/Message/DOM/Element.pm
Suika

Contents of /messaging/manakai/lib/Message/DOM/Element.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.12 - (show annotations) (download)
Sun Dec 3 05:40:33 2006 UTC (17 years, 11 months ago) by wakaba
Branch: MAIN
CVS Tags: manakai-200612
Changes since 1.11: +18 -19 lines
++ manakai/lib/Message/Util/DIS/ChangeLog	3 Dec 2006 05:40:22 -0000
2006-12-03  Wakaba  <wakaba@suika.fam.cx>

	* Perl.dis: Support for obsolete |role|s is removed.

++ manakai/lib/Message/DOM/ChangeLog	3 Dec 2006 05:39:22 -0000
2006-12-03  Wakaba  <wakaba@suika.fam.cx>

	* DOMFeature.dis, TreeCore.dis: Unused |role|s are removed.

1 #!/usr/bin/perl
2 ## This file is automatically generated
3 ## at 2006-12-03T04:32:02+00:00,
4 ## from file "Element.dis",
5 ## module <http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#ManakaiDOM.Element>,
6 ## for <http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#ManakaiDOMLatest>.
7 ## Don't edit by hand!
8 use strict;
9 require Message::DOM::DOMCore;
10 require Message::DOM::Document;
11 require Message::DOM::TreeCore;
12 require Message::Util::Error::DOMException;
13 package Message::DOM::Element;
14 our $VERSION = 20061203.0432;
15 sub DERIVATION_EXTENSION ();
16 sub DERIVATION_LIST ();
17 sub DERIVATION_RESTRICTION ();
18 sub DERIVATION_UNION ();
19 sub AUTOLOAD {
20
21
22 my $al = our $AUTOLOAD;
23 $al =~ s/.+:://;
24 if ({'DERIVATION_EXTENSION',
25 'Message::DOM::IFLatest::TypeInfo::DERIVATION_EXTENSION',
26 'DERIVATION_LIST',
27 'Message::DOM::IFLatest::TypeInfo::DERIVATION_LIST',
28 'DERIVATION_RESTRICTION',
29 'Message::DOM::IFLatest::TypeInfo::DERIVATION_RESTRICTION',
30 'DERIVATION_UNION',
31 'Message::DOM::IFLatest::TypeInfo::DERIVATION_UNION'}->{$al}) {
32 no strict 'refs';
33 *{$AUTOLOAD} = \&{{'DERIVATION_EXTENSION',
34 'Message::DOM::IFLatest::TypeInfo::DERIVATION_EXTENSION',
35 'DERIVATION_LIST',
36 'Message::DOM::IFLatest::TypeInfo::DERIVATION_LIST',
37 'DERIVATION_RESTRICTION',
38 'Message::DOM::IFLatest::TypeInfo::DERIVATION_RESTRICTION',
39 'DERIVATION_UNION',
40 'Message::DOM::IFLatest::TypeInfo::DERIVATION_UNION'}->{$al}};
41 goto &{$AUTOLOAD};
42 } else {
43 require Carp;
44 Carp::croak (qq<Can't locate method "$AUTOLOAD">);
45 }
46
47 }
48 sub import {
49
50
51 my $self = shift;
52 if (@_) {
53 local $Exporter::ExportLevel = $Exporter::ExportLevel + 1;
54 $self->SUPER::import (@_);
55 for (grep {not /\W/} @_) {
56 eval qq{$_};
57 }
58 }
59
60 }
61 our %EXPORT_TAG = ('DerivationMethods',
62 ['DERIVATION_EXTENSION',
63 'DERIVATION_LIST',
64 'DERIVATION_RESTRICTION',
65 'DERIVATION_UNION']);
66 our @EXPORT_OK = ('DERIVATION_EXTENSION',
67 'DERIVATION_LIST',
68 'DERIVATION_RESTRICTION',
69 'DERIVATION_UNION');
70 use Exporter; push our @ISA, 'Exporter';
71 package Message::DOM::Element::ManakaiDOMDocumentElement;
72 our $VERSION = 20061203.0432;
73 push @Message::DOM::Document::ManakaiDOMDocument::ISA, q<Message::DOM::Element::ManakaiDOMDocumentElement> unless Message::DOM::Document::ManakaiDOMDocument->isa (q<Message::DOM::Element::ManakaiDOMDocumentElement>);
74 use Char::Class::XML 'InXMLNCNameChar10',
75 'InXMLNCNameChar11',
76 'InXMLNCNameStartChar11',
77 'InXMLNameChar10',
78 'InXMLNameChar11',
79 'InXMLNameStartChar11',
80 'InXML_NCNameStartChar10',
81 'InXML_NameStartChar10';
82 sub create_element ($$) {
83 my ($self, $tagName) = @_;
84 my $r;
85
86 {
87
88 my
89 $strict = $self->
90 strict_error_checking
91 ;
92 if ($strict) {
93 my $version = $self->
94 xml_version
95 ;
96
97
98 {
99
100 if
101 (defined $tagName) {
102
103
104 {
105
106 if
107 (((not defined $version or $version eq '1.0') and
108 not
109 ($tagName =~ /\A\p{InXML_NameStartChar10}\p{InXMLNameChar10}*\z/)
110 ) or
111 (defined $version and $version eq '1.1' and
112 not
113 ($tagName =~ /\A\p{InXMLNameStartChar11}\p{InXMLNameChar11}*\z/)
114 )) {
115
116 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'INVALID_CHARACTER_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#MDOM_BAD_NAME', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#name' => $tagName, 'http://www.w3.org/2001/04/infoset#version' => $version, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2004/dom/main%23ensureXMLName+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => '$INPUT_PARAM_NAME';
117
118 ;
119 }
120
121
122
123 }
124
125 ;
126
127
128 ;
129 }
130
131
132 }
133
134 ;
135 }
136
137
138 {
139
140 local $Error::Depth = $Error::Depth + 1;
141
142 {
143
144
145
146 $self->
147 strict_error_checking
148 (
149 0
150 );
151 $r = $self->
152 create_element_ns
153 (
154 undef
155 , [
156 undef
157 , $tagName]);
158 $self->
159 strict_error_checking
160 ($strict);
161
162
163
164 }
165
166
167 ;}
168
169 ;
170
171
172 }
173 $r}
174 sub create_element_ns ($$$) {
175 my ($self, $namespaceURI, $qualifiedName) = @_;
176
177 {
178
179 if
180 (CORE::defined $namespaceURI and CORE::length $namespaceURI == 0) {
181 require Message::DOM::DOMMain;
182
183 report Message::DOM::DOMCore::ManakaiDOMError -object => $self, '-type' => 'http://suika.fam.cx/~wakaba/archive/2004/dom/main#empty-namespace-uri', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:tag:suika.fam.cx,2005-09:1165118814:1861:wAUT122229+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest';
184
185 ;
186
187
188
189 {
190
191
192 $namespaceURI = undef;
193
194
195
196 }
197
198 ;
199 }
200
201
202 }
203 my $r;
204
205 {
206
207 my
208 ($prefix, $lname) = ref $qualifiedName eq 'ARRAY'
209 ? @$qualifiedName
210 : split /:/, $qualifiedName, 2;
211 ($prefix, $lname) = (
212 undef
213 , $prefix) unless defined $lname;
214 $qualifiedName = defined $prefix ? $prefix.':'.$lname : $lname;
215
216 if ($self->
217 strict_error_checking
218 ) {
219 my $version = $self->
220 xml_version
221 ;
222
223
224 {
225
226 if
227 (defined $version and $version eq '1.1') {
228 unless (
229 ($qualifiedName =~ /\A\p{InXMLNameStartChar11}\p{InXMLNameChar11}*\z/)
230 ) {
231
232 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'INVALID_CHARACTER_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#MDOM_BAD_NAME', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#name' => $qualifiedName, 'http://www.w3.org/2001/04/infoset#version' => '1.1', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2004/dom/main%23ensureXMLQName+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => '$INPUT_NAME';
233
234 ;
235 }
236 unless (
237 ($qualifiedName =~ /\A\p{InXMLNCNameStartChar11}\p{InXMLNCNameChar11}*(?::\p{InXMLNCNameStartChar11}\p{InXMLNCNameChar11}*)?\z/)
238 ) {
239
240 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NAMESPACE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#MDOM_NS_MALFORMED_QNAME', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#name' => $qualifiedName, 'http://www.w3.org/2001/04/infoset#version' => '1.1', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2004/dom/main%23ensureXMLQName+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => '$INPUT_NAME';
241
242 ;
243 }
244 } else {
245 unless (
246 ($qualifiedName =~ /\A\p{InXML_NameStartChar10}\p{InXMLNameChar10}*\z/)
247 ) {
248
249 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'INVALID_CHARACTER_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#MDOM_BAD_NAME', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#name' => $qualifiedName, 'http://www.w3.org/2001/04/infoset#version' => $version, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2004/dom/main%23ensureXMLQName+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => '$INPUT_NAME';
250
251 ;
252 }
253 unless (
254 ($qualifiedName =~ /\A\p{InXML_NCNameStartChar10}\p{InXMLNCNameChar10}*(?::\p{InXML_NCNameStartChar10}\p{InXMLNCNameChar10}*)?\z/)
255 ) {
256
257 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NAMESPACE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#MDOM_NS_MALFORMED_QNAME', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#name' => $qualifiedName, 'http://www.w3.org/2001/04/infoset#version' => $version, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2004/dom/main%23ensureXMLQName+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => '$INPUT_NAME';
258
259 ;
260 }
261 }
262
263
264 }
265
266 ;
267
268
269 {
270
271 if
272 (defined $prefix) {
273 if (not defined $namespaceURI) {
274
275 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NAMESPACE_ERR', 'http://www.w3.org/2001/04/infoset#prefix' => $prefix, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#MDOM_NS_PREFIX_WITH_NULL_URI', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2004/dom/main%23checkXMLNamesQName+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest';
276
277 ;
278 } elsif ($prefix eq 'xml' and $namespaceURI ne
279 'http://www.w3.org/XML/1998/namespace'
280 ) {
281
282 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NAMESPACE_ERR', 'http://www.w3.org/2001/04/infoset#namespaceName' => $namespaceURI, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#MDOM_NS_XML_WITH_OTHER_URI', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2004/dom/main%23checkXMLNamesQName+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest';
283
284 ;
285 } elsif ($prefix eq 'xmlns' and $namespaceURI ne
286 'http://www.w3.org/2000/xmlns/'
287 ) {
288
289 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NAMESPACE_ERR', 'http://www.w3.org/2001/04/infoset#namespaceName' => $namespaceURI, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#MDOM_NS_XMLNS_WITH_OTHER_URI', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2004/dom/main%23checkXMLNamesQName+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest';
290
291 ;
292 } elsif ($namespaceURI eq
293 'http://www.w3.org/XML/1998/namespace' and
294 $prefix ne 'xml') {
295
296 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NAMESPACE_ERR', 'http://www.w3.org/2001/04/infoset#prefix' => $prefix, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#MDOM_NS_OTHER_WITH_XML_URI', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2004/dom/main%23checkXMLNamesQName+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest';
297
298 ;
299 } elsif ($namespaceURI eq
300 'http://www.w3.org/2000/xmlns/' and
301 $prefix ne 'xmlns') {
302
303 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NAMESPACE_ERR', 'http://www.w3.org/2001/04/infoset#prefix' => $prefix, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#MDOM_NS_OTHER_WITH_XMLNS_URI', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2004/dom/main%23checkXMLNamesQName+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest';
304
305 ;
306 }
307 } else { ## No prefix
308 if (not defined $namespaceURI) {
309 #
310 } elsif ($namespaceURI eq
311 'http://www.w3.org/2000/xmlns/' and
312 $lname ne 'xmlns') {
313
314 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NAMESPACE_ERR', 'http://www.w3.org/2001/04/infoset#prefix' => undef, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#MDOM_NS_OTHER_WITH_XMLNS_URI', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2004/dom/main%23checkXMLNamesQName+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest';
315
316 ;
317 }
318 }
319
320
321 }
322
323 ;
324 if (defined $namespaceURI and $namespaceURI eq
325 'http://www.w3.org/2000/xmlns/' and
326
327 ($qualifiedName eq 'xmlns' or
328 (defined $prefix and $prefix eq 'xmlns'))) {
329
330 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NAMESPACE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'create_element_ns', 'http://www.w3.org/2001/04/infoset#prefix' => $prefix, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Element::ManakaiDOMDocumentElement', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => 'qualifiedName', 'http://www.w3.org/2001/04/infoset#localName' => $lname, 'http://www.w3.org/2001/04/infoset#namespaceName' => $namespaceURI, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#MDOM_NS_OTHER_WITH_XMLNS_URI';
331
332 ;
333 }
334 }
335
336 my $bag =
337 $self->{'b'}
338 ;
339 my $stem;
340
341
342 {
343
344
345 $stem = 'Message::DOM::Element::ManakaiDOMElement'->___create_node_stem ($bag, {
346
347 'rc'
348 => 0,
349
350 'id'
351 => \
352 (
353 'tag:suika.fam.cx,2005-09:' . time . ':' . $$ . ':' .
354 (++$Message::Util::ManakaiNode::UniqueIDN)
355 )
356 ,
357 }, {
358 'od' => $self,
359 'ns' => \$namespaceURI,
360 'pfx' => \$prefix,
361 'ln' => \$lname,
362 });
363
364
365 {
366
367 if
368 (defined 'Message::DOM::Element::ManakaiDOMElement') {
369 if (ref 'Message::DOM::Element::ManakaiDOMElement' eq 'SCALAR') {
370 $stem->{'cls'} = 'Message::DOM::Element::ManakaiDOMElement';
371 } elsif (defined $Message::Util::ManakaiStringRef::Value{'Message::DOM::Element::ManakaiDOMElement'}) {
372 $stem->{'cls'} = $Message::Util::ManakaiStringRef::Value{'Message::DOM::Element::ManakaiDOMElement'};
373 } else {
374 require Scalar::Util;
375 $stem->{'cls'} = $Message::Util::ManakaiStringRef::Value{'Message::DOM::Element::ManakaiDOMElement'} = \('Message::DOM::Element::ManakaiDOMElement');
376 Scalar::Util::weaken ($Message::Util::ManakaiStringRef::Value{'Message::DOM::Element::ManakaiDOMElement'});
377 }
378 } else {
379 CORE::delete $stem->{'cls'};
380 }
381
382
383 }
384
385 ;
386 $bag->{${$stem->{
387 'id'
388 }}} = $stem;
389
390
391 }
392
393 ;
394
395
396 {
397
398
399 $r = ${$stem->{
400 'cls'
401 }}->___create_node_ref ({
402
403 'id'
404 => $stem->{
405 'id'
406 },
407
408 'b'
409 => $bag,
410 }, {
411 });
412 $stem->{
413 'rc'
414 }++;
415
416
417 }
418
419 ;
420
421 ## Default attributes
422
423
424 {
425
426
427 {
428
429 local $Error::Depth = $Error::Depth + 1;
430
431 {
432
433
434 XDA:
435 {
436 my $__cfg = $self->
437 dom_config
438 ;
439 last XDA unless $__cfg->
440 get_parameter
441
442 (
443 'http://suika.fam.cx/www/2006/dom-config/dtd-default-attribute'
444 );
445 my $__doctype = $self->
446 doctype
447 ;
448 last XDA unless defined $__doctype;
449 $__doctype = $__doctype->
450 get_feature
451
452 (
453 'http://suika.fam.cx/www/2006/feature/XDoctype'
454 => '3.0');
455 last XDA unless defined $__doctype;
456 my $__et = $__doctype->
457 get_element_type_definition_node
458
459 ($qualifiedName);
460 if ($__et) {
461 my $__orig_strict = $self->
462 strict_error_checking
463 ;
464 $self->
465 strict_error_checking
466 (
467 0
468 );
469 my %__gattr;
470 my %__has_attr;
471 my %__pfx_to_uri;
472 my $__copy_asis = $__cfg->
473 get_parameter
474
475 (
476 'http://suika.fam.cx/www/2006/dom-config/clone-entity-reference-subtree'
477 );
478 $__cfg->
479 set_parameter
480
481 (
482 'http://suika.fam.cx/www/2006/dom-config/clone-entity-reference-subtree'
483 =>
484 1
485 );
486 for my $__at (@{$__et->
487 attribute_definitions
488 }) {
489 my $__at_default = $__at->
490 default_type
491 ;
492 if ($__at_default ==
493 4 or
494
495 $__at_default ==
496 1
497 ) {
498 my ($__nn1, $__nn2) = split /:/, $__at->
499 node_name
500 ;
501 if (defined $__nn2) { # prefixed
502 if ($__nn1 eq 'xmlns') {
503 ## TODO: NCName check, prefix check and NSURI check
504 my $__attr = $self->
505 create_attribute_ns
506
507 (
508 'http://www.w3.org/2000/xmlns/'
509 , [$__nn1, $__nn2]);
510 for my $__at_child (@{$__at->
511 child_nodes
512 }) {
513 $__attr->
514 append_child
515
516 ($__at_child->
517 clone_node
518 (
519 1
520 ));
521 }
522 $__attr->
523 manakai_attribute_type
524
525 ($__at->
526 declared_type
527 );
528 my $__nsuri = $__attr->
529 value
530 ;
531 ## TODO: Namespace well-formedness check (NSURI), v1.1 chk
532 $__pfx_to_uri{$__nn2} = $__nsuri;
533 $r->
534 set_attribute_node_ns
535 ($__attr);
536 ## This method changes |specified| flag
537 $__attr->
538 specified
539 (
540 0
541 );
542 $__has_attr{
543 'http://www.w3.org/2000/xmlns/'
544 }->{$__nn2} =
545 1
546 ;
547 } else {
548 ## TODO: NCName check
549 $__gattr{$__nn1}->{$__nn2} = $__at;
550 }
551 } else { # no prefixed
552 my $__attr;
553 if ($__nn1 eq 'xmlns') {
554 $__attr = $self->
555 create_attribute_ns
556
557 (
558 'http://www.w3.org/2000/xmlns/'
559 , 'xmlns');
560 $__has_attr{
561 'http://www.w3.org/2000/xmlns/'
562 }->{xmlns} =
563 1
564 ;
565 } else {
566 $__attr = $self->
567 create_attribute_ns
568
569 (
570 undef
571 , $__nn1);
572 ## TODO: NCName check
573 }
574 for my $__at_child (@{$__at->
575 child_nodes
576 }) {
577 $__attr->
578 append_child
579
580 ($__at_child->
581 clone_node
582 (
583 1
584 ));
585 }
586 $__attr->
587 manakai_attribute_type
588
589 ($__at->
590 declared_type
591 );
592 ## TODO: Namespace well-formedness check (NSURI)
593 $r->
594 set_attribute_node_ns
595 ($__attr);
596 ## This method changes |specified| flag
597 $__attr->
598 specified
599 (
600 0
601 );
602 }
603 }
604 } # attrdefs
605 for my $__pfx (keys %__gattr) {
606 my $__nsuri = $__pfx_to_uri{$__pfx};
607 unless (defined $__nsuri) {
608 ## TODO: Namespace well-formedness error
609 }
610 LN: for my $__ln (keys %{$__gattr{$__pfx}}) {
611 if ($__has_attr{defined $__nsuri ? $__nsuri : ''}->{$__ln}) {
612 ## TODO: Namespace well-formedness error
613 next LN;
614 }
615 ## TODO: NCName check, prefix check and NSURI check
616 my $__at = $__gattr{$__pfx}->{$__ln};
617 my $__attr = $self->
618 create_attribute_ns
619
620 ($__nsuri, [$__pfx, $__ln]);
621 for my $__at_child (@{$__at->
622 child_nodes
623 }) {
624 $__attr->
625 append_child
626
627 ($__at_child->
628 clone_node
629 (
630 1
631 ));
632 }
633 $__attr->
634 manakai_attribute_type
635
636 ($__at->
637 declared_type
638 );
639 $r->
640 set_attribute_node_ns
641 ($__attr);
642 ## This method changes |specified| flag
643 $__attr->
644 specified
645 (
646 0
647 );
648 $__has_attr{defined $__nsuri ? $__nsuri : ''}->{$__ln} =
649 1
650 ;
651 } # LN
652 } # pfx
653 $__cfg->
654 set_parameter
655
656 (
657 'http://suika.fam.cx/www/2006/dom-config/clone-entity-reference-subtree'
658 => $__copy_asis);
659 $self->
660 strict_error_checking
661 ($__orig_strict);
662 }
663 } # XDA
664
665
666
667 }
668
669
670 ;}
671
672 ;
673
674
675 }
676
677 ;
678
679
680 }
681 $r}
682 sub create_attribute ($$) {
683 my ($self, $name) = @_;
684 my $r;
685
686 {
687
688 my
689 $strict = $self->
690 strict_error_checking
691 ;
692 if ($strict) {
693 my $version = $self->
694 xml_version
695 ;
696
697
698 {
699
700 if
701 (defined $name) {
702
703
704 {
705
706 if
707 (((not defined $version or $version eq '1.0') and
708 not
709 ($name =~ /\A\p{InXML_NameStartChar10}\p{InXMLNameChar10}*\z/)
710 ) or
711 (defined $version and $version eq '1.1' and
712 not
713 ($name =~ /\A\p{InXMLNameStartChar11}\p{InXMLNameChar11}*\z/)
714 )) {
715
716 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'INVALID_CHARACTER_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#MDOM_BAD_NAME', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#name' => $name, 'http://www.w3.org/2001/04/infoset#version' => $version, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2004/dom/main%23ensureXMLName+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => '$INPUT_PARAM_NAME';
717
718 ;
719 }
720
721
722
723 }
724
725 ;
726
727
728 ;
729 }
730
731
732 }
733
734 ;
735 }
736
737
738 {
739
740 local $Error::Depth = $Error::Depth + 1;
741
742 {
743
744
745
746 $self->
747 strict_error_checking
748 (
749 0
750 );
751 $r = $self->
752 create_attribute_ns
753 (
754 undef
755 , [
756 undef
757 , $name]);
758 $self->
759 strict_error_checking
760 ($strict);
761
762
763
764 }
765
766
767 ;}
768
769 ;
770
771
772 }
773 $r}
774 sub create_attribute_ns ($$$) {
775 my ($self, $namespaceURI, $qualifiedName) = @_;
776
777 {
778
779 if
780 (CORE::defined $namespaceURI and CORE::length $namespaceURI == 0) {
781 require Message::DOM::DOMMain;
782
783 report Message::DOM::DOMCore::ManakaiDOMError -object => $self, '-type' => 'http://suika.fam.cx/~wakaba/archive/2004/dom/main#empty-namespace-uri', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:tag:suika.fam.cx,2005-09:1165118814:1861:wAUT122229+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest';
784
785 ;
786
787
788
789 {
790
791
792 $namespaceURI = undef;
793
794
795
796 }
797
798 ;
799 }
800
801
802 }
803 my $r;
804
805 {
806
807 my
808 ($prefix, $lname) = ref $qualifiedName eq 'ARRAY'
809 ? @$qualifiedName
810 : split /:/, $qualifiedName, 2;
811 ($prefix, $lname) = (
812 undef
813 , $prefix) unless defined $lname;
814
815 ## TODO: autoload
816 if ((defined $namespaceURI and $namespaceURI eq
817 'http://www.w3.org/XML/1998/namespace'
818 ) or
819 ($lname =~ /^xml:/)) {
820 require Message::DOM::XML;
821 }
822
823 if ($self->
824 strict_error_checking
825 ) {
826 my $version = $self->
827 xml_version
828 ;
829 $qualifiedName = defined $prefix ? $prefix.':'.$lname
830 : $lname;
831
832
833 {
834
835 if
836 (defined $version and $version eq '1.1') {
837 unless (
838 ($qualifiedName =~ /\A\p{InXMLNameStartChar11}\p{InXMLNameChar11}*\z/)
839 ) {
840
841 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'INVALID_CHARACTER_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#MDOM_BAD_NAME', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#name' => $qualifiedName, 'http://www.w3.org/2001/04/infoset#version' => '1.1', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2004/dom/main%23ensureXMLQName+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => '$INPUT_NAME';
842
843 ;
844 }
845 unless (
846 ($qualifiedName =~ /\A\p{InXMLNCNameStartChar11}\p{InXMLNCNameChar11}*(?::\p{InXMLNCNameStartChar11}\p{InXMLNCNameChar11}*)?\z/)
847 ) {
848
849 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NAMESPACE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#MDOM_NS_MALFORMED_QNAME', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#name' => $qualifiedName, 'http://www.w3.org/2001/04/infoset#version' => '1.1', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2004/dom/main%23ensureXMLQName+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => '$INPUT_NAME';
850
851 ;
852 }
853 } else {
854 unless (
855 ($qualifiedName =~ /\A\p{InXML_NameStartChar10}\p{InXMLNameChar10}*\z/)
856 ) {
857
858 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'INVALID_CHARACTER_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#MDOM_BAD_NAME', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#name' => $qualifiedName, 'http://www.w3.org/2001/04/infoset#version' => $version, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2004/dom/main%23ensureXMLQName+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => '$INPUT_NAME';
859
860 ;
861 }
862 unless (
863 ($qualifiedName =~ /\A\p{InXML_NCNameStartChar10}\p{InXMLNCNameChar10}*(?::\p{InXML_NCNameStartChar10}\p{InXMLNCNameChar10}*)?\z/)
864 ) {
865
866 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NAMESPACE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#MDOM_NS_MALFORMED_QNAME', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#name' => $qualifiedName, 'http://www.w3.org/2001/04/infoset#version' => $version, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2004/dom/main%23ensureXMLQName+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => '$INPUT_NAME';
867
868 ;
869 }
870 }
871
872
873 }
874
875 ;
876
877
878 {
879
880 if
881 (defined $prefix) {
882 if (not defined $namespaceURI) {
883
884 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NAMESPACE_ERR', 'http://www.w3.org/2001/04/infoset#prefix' => $prefix, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#MDOM_NS_PREFIX_WITH_NULL_URI', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2004/dom/main%23checkXMLNamesQName+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest';
885
886 ;
887 } elsif ($prefix eq 'xml' and $namespaceURI ne
888 'http://www.w3.org/XML/1998/namespace'
889 ) {
890
891 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NAMESPACE_ERR', 'http://www.w3.org/2001/04/infoset#namespaceName' => $namespaceURI, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#MDOM_NS_XML_WITH_OTHER_URI', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2004/dom/main%23checkXMLNamesQName+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest';
892
893 ;
894 } elsif ($prefix eq 'xmlns' and $namespaceURI ne
895 'http://www.w3.org/2000/xmlns/'
896 ) {
897
898 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NAMESPACE_ERR', 'http://www.w3.org/2001/04/infoset#namespaceName' => $namespaceURI, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#MDOM_NS_XMLNS_WITH_OTHER_URI', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2004/dom/main%23checkXMLNamesQName+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest';
899
900 ;
901 } elsif ($namespaceURI eq
902 'http://www.w3.org/XML/1998/namespace' and
903 $prefix ne 'xml') {
904
905 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NAMESPACE_ERR', 'http://www.w3.org/2001/04/infoset#prefix' => $prefix, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#MDOM_NS_OTHER_WITH_XML_URI', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2004/dom/main%23checkXMLNamesQName+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest';
906
907 ;
908 } elsif ($namespaceURI eq
909 'http://www.w3.org/2000/xmlns/' and
910 $prefix ne 'xmlns') {
911
912 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NAMESPACE_ERR', 'http://www.w3.org/2001/04/infoset#prefix' => $prefix, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#MDOM_NS_OTHER_WITH_XMLNS_URI', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2004/dom/main%23checkXMLNamesQName+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest';
913
914 ;
915 }
916 } else { ## No prefix
917 if (not defined $namespaceURI) {
918 #
919 } elsif ($namespaceURI eq
920 'http://www.w3.org/2000/xmlns/' and
921 $lname ne 'xmlns') {
922
923 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NAMESPACE_ERR', 'http://www.w3.org/2001/04/infoset#prefix' => undef, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#MDOM_NS_OTHER_WITH_XMLNS_URI', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2004/dom/main%23checkXMLNamesQName+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest';
924
925 ;
926 }
927 }
928
929
930 }
931
932 ;
933 }
934
935 my $bag =
936 $self->{'b'}
937 ;
938 my $stem;
939
940
941 {
942
943
944 $stem = 'Message::DOM::Element::ManakaiDOMAttr'->___create_node_stem ($bag, {
945
946 'rc'
947 => 0,
948
949 'id'
950 => \
951 (
952 'tag:suika.fam.cx,2005-09:' . time . ':' . $$ . ':' .
953 (++$Message::Util::ManakaiNode::UniqueIDN)
954 )
955 ,
956 }, {
957 'od' => $self,
958 'ns' => \$namespaceURI,
959 'pfx' => \$prefix,
960 'ln' => \$lname,
961 'specified' => 1,
962 });
963
964
965 {
966
967 if
968 (defined 'Message::DOM::Element::ManakaiDOMAttr') {
969 if (ref 'Message::DOM::Element::ManakaiDOMAttr' eq 'SCALAR') {
970 $stem->{'cls'} = 'Message::DOM::Element::ManakaiDOMAttr';
971 } elsif (defined $Message::Util::ManakaiStringRef::Value{'Message::DOM::Element::ManakaiDOMAttr'}) {
972 $stem->{'cls'} = $Message::Util::ManakaiStringRef::Value{'Message::DOM::Element::ManakaiDOMAttr'};
973 } else {
974 require Scalar::Util;
975 $stem->{'cls'} = $Message::Util::ManakaiStringRef::Value{'Message::DOM::Element::ManakaiDOMAttr'} = \('Message::DOM::Element::ManakaiDOMAttr');
976 Scalar::Util::weaken ($Message::Util::ManakaiStringRef::Value{'Message::DOM::Element::ManakaiDOMAttr'});
977 }
978 } else {
979 CORE::delete $stem->{'cls'};
980 }
981
982
983 }
984
985 ;
986 $bag->{${$stem->{
987 'id'
988 }}} = $stem;
989
990
991 }
992
993 ;
994
995
996 {
997
998
999 $r = ${$stem->{
1000 'cls'
1001 }}->___create_node_ref ({
1002
1003 'id'
1004 => $stem->{
1005 'id'
1006 },
1007
1008 'b'
1009 => $bag,
1010 }, {
1011 });
1012 $stem->{
1013 'rc'
1014 }++;
1015
1016
1017 }
1018
1019 ;
1020
1021 ## Attribute type information
1022 if ((defined $namespaceURI and $namespaceURI eq
1023 'http://www.w3.org/XML/1998/namespace' and
1024
1025 $lname eq 'id') or
1026 (not defined $namespaceURI and $lname eq 'xml:id')) {
1027
1028
1029 {
1030
1031 local $Error::Depth = $Error::Depth + 1;
1032
1033 {
1034
1035
1036 if
1037 ($self->
1038 dom_config
1039
1040 ->
1041 get_parameter
1042
1043 (
1044 'http://suika.fam.cx/www/2006/dom-config/xml-id'
1045 )) {
1046 $r->
1047 manakai_attribute_type
1048 (
1049 2
1050 );
1051 }
1052
1053
1054
1055 }
1056
1057
1058 ;}
1059
1060 ;
1061 }
1062
1063
1064 }
1065 $r}
1066 $Message::DOM::DOMFeature::ClassInfo->{q<Message::DOM::Element::ManakaiDOMDocumentElement>}->{has_feature} = {};
1067 $Message::DOM::ClassPoint{q<Message::DOM::Element::ManakaiDOMDocumentElement>} = 0;
1068 package Message::DOM::IFLatest::Element;
1069 our $VERSION = 20061203.0432;
1070 package Message::DOM::Element::ManakaiDOMElement;
1071 our $VERSION = 20061203.0432;
1072 push our @ISA, 'Message::DOM::TreeCore::ManakaiDOMNode',
1073 'Message::DOM::IF::Element',
1074 'Message::DOM::IF::Node',
1075 'Message::DOM::IFLatest::Element',
1076 'Message::DOM::IFLatest::Node',
1077 'Message::DOM::IFLevel1::Element',
1078 'Message::DOM::IFLevel1::Node',
1079 'Message::DOM::IFLevel2::Element',
1080 'Message::DOM::IFLevel2::Node',
1081 'Message::DOM::IFLevel3::Element',
1082 'Message::DOM::IFLevel3::Node';
1083 use Char::Class::XML 'InXMLNCNameChar10',
1084 'InXMLNCNameChar11',
1085 'InXMLNCNameStartChar11',
1086 'InXMLNameChar10',
1087 'InXMLNameChar11',
1088 'InXMLNameStartChar11',
1089 'InXML_NCNameStartChar10',
1090 'InXML_NameStartChar10';
1091 sub ___create_node_stem ($$$$) {
1092 my ($self, $bag, $obj, $opt) = @_;
1093 my $r = {};
1094
1095 {
1096
1097
1098 $obj->{
1099 'child'
1100 } = [];
1101 $obj->{
1102 'attr'
1103 } = {};
1104
1105
1106 {
1107
1108 if
1109 (defined ${$opt->{'ns'}}) {
1110 if (ref ${$opt->{'ns'}} eq 'SCALAR') {
1111 $obj->{'ns'} = ${$opt->{'ns'}};
1112 } elsif (defined $Message::Util::ManakaiStringRef::Value{${$opt->{'ns'}}}) {
1113 $obj->{'ns'} = $Message::Util::ManakaiStringRef::Value{${$opt->{'ns'}}};
1114 } else {
1115 require Scalar::Util;
1116 $obj->{'ns'} = $Message::Util::ManakaiStringRef::Value{${$opt->{'ns'}}} = \(${$opt->{'ns'}});
1117 Scalar::Util::weaken ($Message::Util::ManakaiStringRef::Value{${$opt->{'ns'}}});
1118 }
1119 } else {
1120 CORE::delete $obj->{'ns'};
1121 }
1122
1123
1124 }
1125
1126 ;
1127
1128
1129 {
1130
1131 if
1132 (defined ${$opt->{'pfx'}}) {
1133 if (ref ${$opt->{'pfx'}} eq 'SCALAR') {
1134 $obj->{'pfx'} = ${$opt->{'pfx'}};
1135 } elsif (defined $Message::Util::ManakaiStringRef::Value{${$opt->{'pfx'}}}) {
1136 $obj->{'pfx'} = $Message::Util::ManakaiStringRef::Value{${$opt->{'pfx'}}};
1137 } else {
1138 require Scalar::Util;
1139 $obj->{'pfx'} = $Message::Util::ManakaiStringRef::Value{${$opt->{'pfx'}}} = \(${$opt->{'pfx'}});
1140 Scalar::Util::weaken ($Message::Util::ManakaiStringRef::Value{${$opt->{'pfx'}}});
1141 }
1142 } else {
1143 CORE::delete $obj->{'pfx'};
1144 }
1145
1146
1147 }
1148
1149 ;
1150
1151
1152 {
1153
1154 if
1155 (defined ${$opt->{'ln'}}) {
1156 if (ref ${$opt->{'ln'}} eq 'SCALAR') {
1157 $obj->{'ln'} = ${$opt->{'ln'}};
1158 } elsif (defined $Message::Util::ManakaiStringRef::Value{${$opt->{'ln'}}}) {
1159 $obj->{'ln'} = $Message::Util::ManakaiStringRef::Value{${$opt->{'ln'}}};
1160 } else {
1161 require Scalar::Util;
1162 $obj->{'ln'} = $Message::Util::ManakaiStringRef::Value{${$opt->{'ln'}}} = \(${$opt->{'ln'}});
1163 Scalar::Util::weaken ($Message::Util::ManakaiStringRef::Value{${$opt->{'ln'}}});
1164 }
1165 } else {
1166 CORE::delete $obj->{'ln'};
1167 }
1168
1169
1170 }
1171
1172 ;
1173
1174
1175 {
1176
1177
1178 $obj->{'od'} = $opt->{'od'}->{
1179 'id'
1180 };
1181 $bag->{${$opt->{'od'}->{
1182 'id'
1183 }}}
1184 ->{'do'}->{${$obj->{
1185 'id'
1186 }}}
1187 = $obj->{
1188 'id'
1189 };
1190
1191
1192 }
1193
1194 ;
1195 $r = $obj;
1196
1197
1198 }
1199 $r}
1200 sub ___create_node_ref ($$$) {
1201 my ($self, $obj, $opt) = @_;
1202 my $r;
1203
1204 {
1205
1206 my
1207 $class;
1208 CLS: {
1209 ## From the cache
1210
1211
1212 {
1213
1214
1215 $class = $obj->{
1216 'b'
1217 }->{${$obj->{
1218 'id'
1219 }}}
1220 ->{'dnrcls'};
1221
1222
1223 }
1224
1225 ;
1226 if (defined $class) {
1227 last CLS;
1228 } else {
1229 $class = \$self;
1230 }
1231
1232 my $nsuri;
1233
1234
1235 {
1236
1237
1238 $nsuri = $obj->{
1239 'b'
1240 }->{${$obj->{
1241 'id'
1242 }}}
1243 ->{'ns'};
1244
1245
1246 }
1247
1248 ;
1249 $nsuri = \'' unless defined $nsuri;
1250 my $ln;
1251
1252
1253 {
1254
1255
1256 $ln = $obj->{
1257 'b'
1258 }->{${$obj->{
1259 'id'
1260 }}}
1261 ->{'ln'};
1262
1263
1264 }
1265
1266 ;
1267
1268 ## Use cases:
1269 ## - |html5:a| element type
1270 ## - |html5:*| element types
1271 A: for my $nm (
1272 [$nsuri, $ln],
1273 [$nsuri, \'*'],
1274 ) {
1275 unless ($Message::DOM::Element::ElementClass
1276 ->{${$nm->[0]}}->{${$nm->[1]}}) {
1277 if ($Message::Util::AutoLoad::Registry::ElementType
1278 ->{${$nm->[0]}}->{${$nm->[1]}}) {
1279 eval qq{require
1280 $Message::Util::AutoLoad::Registry::ElementType->{
1281 ${$nm->[0]}}->{${$nm->[1]}}->{module}};
1282 die $@ if $@;
1283 }
1284 }
1285
1286 if ($Message::DOM::Element::ElementClass
1287 ->{${$nm->[0]}}->{${$nm->[1]}}) {
1288 $class = \($Message::DOM::Element::ElementClass
1289 ->{${$nm->[0]}}->{${$nm->[1]}});
1290 last A;
1291 }
1292 } # A
1293
1294
1295
1296 {
1297
1298
1299 $obj->{
1300 'b'
1301 }->{${$obj->{
1302 'id'
1303 }}}
1304 ->{'dnrcls'} = $class;
1305
1306
1307 }
1308
1309 ;
1310 } # CLS
1311 $r = bless $obj, $$class;
1312
1313
1314 }
1315 $r}
1316 sub node_type ($;$) {
1317 if (@_ == 1) {my ($self) = @_;
1318 my $r;
1319 $r = 1;
1320 $r;
1321 } else {my ($self) = @_;
1322 report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Element::ManakaiDOMElement', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'node_type';
1323 }
1324 }
1325 sub prefix ($;$) {
1326 if (@_ == 1) {my ($self) = @_;
1327 my $r = '';
1328
1329 {
1330
1331 my
1332 $v;
1333
1334
1335 {
1336
1337
1338 $v = $self->{
1339 'b'
1340 }->{${$self->{
1341 'id'
1342 }}}
1343 ->{'pfx'};
1344
1345
1346 }
1347
1348 ;
1349 $r = defined $v ? $$v :
1350 undef
1351 ;
1352
1353
1354 }
1355 $r;
1356 } else {my ($self, $given) = @_;
1357
1358 {
1359
1360 my
1361 $od = $self->
1362 owner_document
1363 ;
1364 if ($od->
1365 strict_error_checking
1366 ) {
1367
1368
1369 {
1370
1371 if
1372 ($self->
1373 manakai_read_only
1374 ) {
1375
1376 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#NOMOD_THIS', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/NodeReadOnlyError+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest';
1377
1378 ;
1379 }
1380
1381
1382 }
1383
1384 ;
1385 my $nsuri;
1386
1387
1388 {
1389
1390
1391 $nsuri = $self->{
1392 'b'
1393 }->{${$self->{
1394 'id'
1395 }}}
1396 ->{'ns'};
1397
1398
1399 }
1400
1401 ;
1402 if (not defined $nsuri) {
1403
1404 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NAMESPACE_ERR', 'http://www.w3.org/2001/04/infoset#namespaceName' => undef, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'set', 'http://www.w3.org/2001/04/infoset#prefix' => $given, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#MDOM_NS_PREFIX_WITH_NULL_URI', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Element::ManakaiDOMElement', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'prefix';
1405
1406 ;
1407 } elsif ($$nsuri ne
1408 'http://www.w3.org/XML/1998/namespace' and
1409
1410 defined $given and $given eq 'xml') {
1411
1412 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NAMESPACE_ERR', 'http://www.w3.org/2001/04/infoset#namespaceName' => $self->namespace_uri, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'set', 'http://www.w3.org/2001/04/infoset#prefix' => $given, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#MDOM_NS_XML_WITH_OTHER_URI', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Element::ManakaiDOMElement', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'prefix';
1413
1414 ;
1415 }
1416 my $version = $od->
1417 xml_version
1418 ;
1419
1420
1421 {
1422
1423 if
1424 (defined $given and $given eq '') {
1425 require Message::DOM::DOMMain;
1426
1427 report Message::DOM::DOMCore::ManakaiDOMError -object => $self, '-type' => 'http://suika.fam.cx/~wakaba/archive/2004/dom/main#empty-namespace-prefix', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2004/dom/main%23ensureNamespacePrefix+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest';
1428
1429 ;
1430 undef $given;
1431 }
1432 if (defined $given) {
1433 if (($version eq '1.0' and
1434 not
1435 ($given =~ /\A\p{InXML_NameStartChar10}\p{InXMLNameChar10}*\z/)
1436 ) or
1437 ($version eq '1.1' and
1438 not
1439 ($given =~ /\A\p{InXMLNameStartChar11}\p{InXMLNameChar11}*\z/)
1440 )) {
1441
1442 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'INVALID_CHARACTER_ERR', 'http://www.w3.org/2001/04/infoset#name' => $given, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#MDOM_BAD_NAME', 'http://www.w3.org/2001/04/infoset#version' => $version, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2004/dom/main%23ensureNamespacePrefix+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => '$INPUT_PARAM_NAME';
1443
1444 ;
1445 } elsif (index ($given, ':') > -1) {
1446
1447 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NAMESPACE_ERR', 'http://www.w3.org/2001/04/infoset#name' => $given, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#MDOM_NS_BAD_NCNAME', 'http://www.w3.org/2001/04/infoset#version' => $version, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2004/dom/main%23ensureNamespacePrefix+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => '$INPUT_PARAM_NAME';
1448
1449 ;
1450 }
1451 } # has prefix
1452
1453
1454 }
1455
1456 ;
1457 } # strict
1458 my $v = defined $given ? \$given :
1459 undef
1460 ;
1461
1462
1463 {
1464
1465
1466 $self->{
1467 'b'
1468 }->{${$self->{
1469 'id'
1470 }}}
1471 ->{'pfx'} = $v;
1472
1473
1474 }
1475
1476 ;
1477
1478
1479 }
1480 }
1481 }
1482 sub append_child ($$) {
1483 my ($self, $newChild) = @_;
1484 my $r;
1485
1486 {
1487
1488 my
1489 $self_od = $self->
1490 owner_document
1491 ;
1492 if ($self_od->
1493 strict_error_checking
1494 ) {
1495 my $anode = $self;
1496 while (defined $anode) {
1497 if ($anode eq $newChild) {
1498
1499 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'HIERARCHY_REQUEST_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'append_child', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#HIERARCHY_ANCESTOR_OR_SELF', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Element::ManakaiDOMElement', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => 'newChild', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#node' => $newChild;
1500
1501 ;
1502 }
1503 $anode = $anode->
1504 parent_node
1505 ;
1506 }
1507 }
1508 my $child_od = $newChild->
1509 owner_document
1510 ;
1511 my $child_nt = $newChild->
1512 node_type
1513 ;
1514
1515
1516 {
1517
1518
1519 {
1520
1521 local $Error::Depth = $Error::Depth + 1;
1522
1523 {
1524
1525
1526 my
1527 $strict = $self_od->
1528 strict_error_checking
1529 ;
1530
1531 ## -- Node Type check
1532 my @new_child;
1533 if ({
1534 3 => 1,
1535 5 => 1,
1536 1 => 1,
1537 4 => 1,
1538 7 => 1,
1539 8 => 1,
1540 }->{$child_nt}) {
1541 push @new_child, $newChild;
1542 } elsif ($child_nt ==
1543 11
1544 ) {
1545 for my $cn (@{$newChild->
1546 child_nodes
1547 }) {
1548 unless ({
1549 3 => 1,
1550 5 => 1,
1551 1 => 1,
1552 4 => 1,
1553 7 => 1,
1554 8 => 1,
1555 }->{$cn->
1556 node_type
1557 }) {
1558
1559
1560 {
1561
1562 local $Error::Depth = $Error::Depth - 1;
1563
1564 {
1565
1566 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'HIERARCHY_REQUEST_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#HIERARCHY_BAD_TYPE', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/appendChildImpl1+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => 'newChild', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#node' => $newChild;
1567
1568
1569 }
1570
1571
1572 ;}
1573
1574 ;
1575 }
1576 push @new_child, $cn;
1577 }
1578 } else {
1579
1580
1581 {
1582
1583 local $Error::Depth = $Error::Depth - 1;
1584
1585 {
1586
1587 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'HIERARCHY_REQUEST_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#HIERARCHY_BAD_TYPE', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/appendChildImpl1+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => 'newChild', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#node' => $newChild;
1588
1589
1590 }
1591
1592
1593 ;}
1594
1595 ;
1596 }
1597
1598 my $nc_parent = @new_child ? $new_child[0]->
1599 parent_node
1600 :
1601
1602 undef
1603 ;
1604 if ($strict) {
1605 ## -- Wrong-document check
1606 unless ($self_od eq $child_od) {
1607
1608
1609 {
1610
1611 local $Error::Depth = $Error::Depth - 1;
1612
1613 {
1614
1615 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'WRONG_DOCUMENT_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#DIFFERENT_DOCUMENT_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/appendChildImpl1+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => 'newChild', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#node' => $newChild;
1616
1617
1618 }
1619
1620
1621 ;}
1622
1623 ;
1624 }
1625
1626 ## -- Read-onlyness check
1627 if ($self->
1628 manakai_read_only
1629 ) {
1630
1631
1632 {
1633
1634 local $Error::Depth = $Error::Depth - 1;
1635
1636 {
1637
1638 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#NOMOD_THIS', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/appendChildImpl1+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest';
1639
1640
1641 }
1642
1643
1644 ;}
1645
1646 ;
1647 }
1648 if (@new_child) {
1649 if ($nc_parent and
1650 $nc_parent->
1651 manakai_read_only
1652 ) {
1653
1654
1655 {
1656
1657 local $Error::Depth = $Error::Depth - 1;
1658
1659 {
1660
1661 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#NOMOD_SRC_PARENT', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/appendChildImpl1+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest';
1662
1663
1664 }
1665
1666
1667 ;}
1668
1669 ;
1670 }
1671 }
1672 }
1673
1674 ## -- Insert at...
1675 my $index = -1; # last
1676
1677
1678 ; # FOR !tc:ForAppendChild
1679
1680 ## -- Removes from parent
1681 if ($nc_parent) {
1682 if ($child_nt ==
1683 11
1684 ) {
1685
1686
1687 {
1688
1689
1690 $newChild->{
1691 'b'
1692 }->{${$newChild->{
1693 'id'
1694 }}}
1695 ->{'child'} = [];
1696
1697
1698 }
1699
1700 ;
1701 } else {
1702 my $v;
1703
1704
1705 {
1706
1707
1708 $v = $nc_parent->{
1709 'b'
1710 }->{${$nc_parent->{
1711 'id'
1712 }}}
1713 ->{'child'};
1714
1715
1716 }
1717
1718 ;
1719 RP: for my $i (0..$#$v) {
1720 my $nodeid = $v->[$i];
1721 if (
1722 (${$new_child[0]->{'id'}} eq ${$nodeid})
1723 ) {
1724 splice @$v, $i, 1, ();
1725 last RP;
1726 }
1727 } # RP
1728 }
1729 }
1730
1731 ## -- Rewrite the |parentNode| properties
1732 for my $nc (@new_child) {
1733
1734
1735 {
1736
1737
1738 $nc->{
1739 'b'
1740 }->{${$nc->{
1741 'id'
1742 }}}
1743 ->{'parent'} = $self->{
1744 'id'
1745 };
1746
1747
1748 }
1749
1750 ;
1751 }
1752
1753 my $children;
1754
1755
1756 {
1757
1758
1759 $children = $self->{
1760 'b'
1761 }->{${$self->{
1762 'id'
1763 }}}
1764 ->{'child'};
1765
1766
1767 }
1768
1769 ;
1770
1771
1772
1773 {
1774
1775
1776 ## -- Adds to children list
1777 push @$children, map {
1778
1779 $_->{'id'}
1780
1781 } @new_child;
1782 $r = $newChild;
1783
1784
1785
1786 }
1787
1788 ;
1789
1790
1791
1792 ;
1793
1794
1795
1796 ;
1797
1798
1799
1800 }
1801
1802
1803 ;}
1804
1805 ;
1806
1807
1808 }
1809
1810 ;
1811
1812
1813 }
1814 $r}
1815 sub insert_before ($$;$) {
1816 my ($self, $newChild, $refChild) = @_;
1817 my $r;
1818
1819 {
1820
1821 my
1822 $self_od = $self->
1823 owner_document
1824 ;
1825 if ($self_od->
1826 strict_error_checking
1827 ) {
1828 my $anode = $self;
1829 while (defined $anode) {
1830 if ($anode eq $newChild) {
1831
1832 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'HIERARCHY_REQUEST_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'insert_before', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#HIERARCHY_ANCESTOR_OR_SELF', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Element::ManakaiDOMElement', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => 'newChild', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#node' => $newChild;
1833
1834 ;
1835 }
1836 $anode = $anode->
1837 parent_node
1838 ;
1839 }
1840 }
1841 my $child_od = $newChild->
1842 owner_document
1843 ;
1844 my $child_nt = $newChild->
1845 node_type
1846 ;
1847
1848
1849 {
1850
1851
1852 {
1853
1854 local $Error::Depth = $Error::Depth + 1;
1855
1856 {
1857
1858
1859 my
1860 $strict = $self_od->
1861 strict_error_checking
1862 ;
1863
1864 ## -- Node Type check
1865 my @new_child;
1866 if ({
1867 3 => 1,
1868 5 => 1,
1869 1 => 1,
1870 4 => 1,
1871 7 => 1,
1872 8 => 1,
1873 }->{$child_nt}) {
1874 push @new_child, $newChild;
1875 } elsif ($child_nt ==
1876 11
1877 ) {
1878 for my $cn (@{$newChild->
1879 child_nodes
1880 }) {
1881 unless ({
1882 3 => 1,
1883 5 => 1,
1884 1 => 1,
1885 4 => 1,
1886 7 => 1,
1887 8 => 1,
1888 }->{$cn->
1889 node_type
1890 }) {
1891
1892
1893 {
1894
1895 local $Error::Depth = $Error::Depth - 1;
1896
1897 {
1898
1899 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'HIERARCHY_REQUEST_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#HIERARCHY_BAD_TYPE', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/insertBeforeImpl1+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => 'newChild', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#node' => $newChild;
1900
1901
1902 }
1903
1904
1905 ;}
1906
1907 ;
1908 }
1909 push @new_child, $cn;
1910 }
1911 } else {
1912
1913
1914 {
1915
1916 local $Error::Depth = $Error::Depth - 1;
1917
1918 {
1919
1920 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'HIERARCHY_REQUEST_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#HIERARCHY_BAD_TYPE', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/insertBeforeImpl1+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => 'newChild', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#node' => $newChild;
1921
1922
1923 }
1924
1925
1926 ;}
1927
1928 ;
1929 }
1930
1931 my $nc_parent = @new_child ? $new_child[0]->
1932 parent_node
1933 :
1934
1935 undef
1936 ;
1937 if ($strict) {
1938 ## -- Wrong-document check
1939 unless ($self_od eq $child_od) {
1940
1941
1942 {
1943
1944 local $Error::Depth = $Error::Depth - 1;
1945
1946 {
1947
1948 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'WRONG_DOCUMENT_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#DIFFERENT_DOCUMENT_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/insertBeforeImpl1+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => 'newChild', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#node' => $newChild;
1949
1950
1951 }
1952
1953
1954 ;}
1955
1956 ;
1957 }
1958
1959 ## -- Read-onlyness check
1960 if ($self->
1961 manakai_read_only
1962 ) {
1963
1964
1965 {
1966
1967 local $Error::Depth = $Error::Depth - 1;
1968
1969 {
1970
1971 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#NOMOD_THIS', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/insertBeforeImpl1+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest';
1972
1973
1974 }
1975
1976
1977 ;}
1978
1979 ;
1980 }
1981 if (@new_child) {
1982 if ($nc_parent and
1983 $nc_parent->
1984 manakai_read_only
1985 ) {
1986
1987
1988 {
1989
1990 local $Error::Depth = $Error::Depth - 1;
1991
1992 {
1993
1994 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#NOMOD_SRC_PARENT', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/insertBeforeImpl1+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest';
1995
1996
1997 }
1998
1999
2000 ;}
2001
2002 ;
2003 }
2004 }
2005 }
2006
2007 ## -- Insert at...
2008 my $index = -1; # last
2009
2010
2011 {
2012
2013
2014 # tc:ForAppendChild & tc:ForReplaceChild
2015 if (defined $refChild) {
2016 if ($refChild eq $newChild) {
2017
2018
2019 {
2020
2021
2022 {
2023
2024 local $Error::Depth = $Error::Depth - 1;
2025
2026 {
2027
2028 report Message::DOM::DOMCore::ManakaiDOMError -object => $self, '-type' => 'http://suika.fam.cx/~wakaba/archive/2004/dom/tree#insert-before-itself', 'rdata' => $refChild, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/insertBeforeImpl1+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest';
2029
2030
2031 }
2032
2033
2034 ;}
2035
2036 ;
2037
2038
2039
2040 }
2041
2042 ;
2043
2044
2045 ;
2046 }
2047
2048 my $cns = $self->
2049 child_nodes
2050 ;
2051 my $cnsl = @$cns;
2052 C: {
2053 $index = 0;
2054 for my $i (0..($cnsl-1)) {
2055 my $cn = $cns->[$i];
2056 if ($cn eq $refChild) {
2057 $index += $i;
2058 last C;
2059 } elsif ($cn eq $newChild) {
2060 $index = -1; # offset
2061 }
2062 }
2063
2064
2065 {
2066
2067
2068 {
2069
2070 local $Error::Depth = $Error::Depth - 1;
2071
2072 {
2073
2074 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NOT_FOUND_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#NOT_CHILD_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/insertBeforeImpl1+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => 'refChild', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#node' => $refChild;
2075
2076
2077 }
2078
2079
2080 ;}
2081
2082 ;
2083
2084
2085
2086 }
2087
2088 ;
2089
2090
2091 ;
2092 } # C
2093 } else { # |oldChild| is not defined
2094
2095
2096 ;
2097 }
2098
2099
2100
2101 }
2102
2103 ; # FOR !tc:ForAppendChild
2104
2105 ## -- Removes from parent
2106 if ($nc_parent) {
2107 if ($child_nt ==
2108 11
2109 ) {
2110
2111
2112 {
2113
2114
2115 $newChild->{
2116 'b'
2117 }->{${$newChild->{
2118 'id'
2119 }}}
2120 ->{'child'} = [];
2121
2122
2123 }
2124
2125 ;
2126 } else {
2127 my $v;
2128
2129
2130 {
2131
2132
2133 $v = $nc_parent->{
2134 'b'
2135 }->{${$nc_parent->{
2136 'id'
2137 }}}
2138 ->{'child'};
2139
2140
2141 }
2142
2143 ;
2144 RP: for my $i (0..$#$v) {
2145 my $nodeid = $v->[$i];
2146 if (
2147 (${$new_child[0]->{'id'}} eq ${$nodeid})
2148 ) {
2149 splice @$v, $i, 1, ();
2150 last RP;
2151 }
2152 } # RP
2153 }
2154 }
2155
2156 ## -- Rewrite the |parentNode| properties
2157 for my $nc (@new_child) {
2158
2159
2160 {
2161
2162
2163 $nc->{
2164 'b'
2165 }->{${$nc->{
2166 'id'
2167 }}}
2168 ->{'parent'} = $self->{
2169 'id'
2170 };
2171
2172
2173 }
2174
2175 ;
2176 }
2177
2178 my $children;
2179
2180
2181 {
2182
2183
2184 $children = $self->{
2185 'b'
2186 }->{${$self->{
2187 'id'
2188 }}}
2189 ->{'child'};
2190
2191
2192 }
2193
2194 ;
2195
2196
2197
2198 ;
2199
2200
2201
2202 {
2203
2204
2205 ## -- Adds to children list
2206 if ($index == -1) {
2207 push @$children, map {
2208
2209 $_->{'id'}
2210
2211 } @new_child;
2212 } else {
2213 splice @$children, $index, 0, map {
2214
2215 $_->{'id'}
2216
2217 } @new_child;
2218 }
2219 $r = $newChild;
2220
2221
2222
2223 }
2224
2225 ;
2226
2227
2228
2229 ;
2230
2231
2232
2233 }
2234
2235
2236 ;}
2237
2238 ;
2239
2240
2241 }
2242
2243 ;
2244
2245
2246 }
2247 $r}
2248 sub replace_child ($$$) {
2249 my ($self, $newChild, $oldChild) = @_;
2250 my $r;
2251
2252 {
2253
2254 my
2255 $self_od = $self->
2256 owner_document
2257 ;
2258 if ($self_od->
2259 strict_error_checking
2260 ) {
2261 my $anode = $self;
2262 while (defined $anode) {
2263 if ($anode eq $newChild) {
2264
2265 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'HIERARCHY_REQUEST_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'replace_child', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#HIERARCHY_ANCESTOR_OR_SELF', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Element::ManakaiDOMElement', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => 'newChild', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#node' => $newChild;
2266
2267 ;
2268 }
2269 $anode = $anode->
2270 parent_node
2271 ;
2272 }
2273 }
2274 my $child_od = $newChild->
2275 owner_document
2276 ;
2277 my $child_nt = $newChild->
2278 node_type
2279 ;
2280
2281
2282 {
2283
2284
2285 {
2286
2287 local $Error::Depth = $Error::Depth + 1;
2288
2289 {
2290
2291
2292 my
2293 $strict = $self_od->
2294 strict_error_checking
2295 ;
2296
2297 ## -- Node Type check
2298 my @new_child;
2299 if ({
2300 3 => 1,
2301 5 => 1,
2302 1 => 1,
2303 4 => 1,
2304 7 => 1,
2305 8 => 1,
2306 }->{$child_nt}) {
2307 push @new_child, $newChild;
2308 } elsif ($child_nt ==
2309 11
2310 ) {
2311 for my $cn (@{$newChild->
2312 child_nodes
2313 }) {
2314 unless ({
2315 3 => 1,
2316 5 => 1,
2317 1 => 1,
2318 4 => 1,
2319 7 => 1,
2320 8 => 1,
2321 }->{$cn->
2322 node_type
2323 }) {
2324
2325
2326 {
2327
2328 local $Error::Depth = $Error::Depth - 1;
2329
2330 {
2331
2332 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'HIERARCHY_REQUEST_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#HIERARCHY_BAD_TYPE', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/replaceChildImpl1+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => 'newChild', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#node' => $newChild;
2333
2334
2335 }
2336
2337
2338 ;}
2339
2340 ;
2341 }
2342 push @new_child, $cn;
2343 }
2344 } else {
2345
2346
2347 {
2348
2349 local $Error::Depth = $Error::Depth - 1;
2350
2351 {
2352
2353 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'HIERARCHY_REQUEST_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#HIERARCHY_BAD_TYPE', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/replaceChildImpl1+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => 'newChild', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#node' => $newChild;
2354
2355
2356 }
2357
2358
2359 ;}
2360
2361 ;
2362 }
2363
2364 my $nc_parent = @new_child ? $new_child[0]->
2365 parent_node
2366 :
2367
2368 undef
2369 ;
2370 if ($strict) {
2371 ## -- Wrong-document check
2372 unless ($self_od eq $child_od) {
2373
2374
2375 {
2376
2377 local $Error::Depth = $Error::Depth - 1;
2378
2379 {
2380
2381 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'WRONG_DOCUMENT_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#DIFFERENT_DOCUMENT_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/replaceChildImpl1+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => 'newChild', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#node' => $newChild;
2382
2383
2384 }
2385
2386
2387 ;}
2388
2389 ;
2390 }
2391
2392 ## -- Read-onlyness check
2393 if ($self->
2394 manakai_read_only
2395 ) {
2396
2397
2398 {
2399
2400 local $Error::Depth = $Error::Depth - 1;
2401
2402 {
2403
2404 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#NOMOD_THIS', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/replaceChildImpl1+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest';
2405
2406
2407 }
2408
2409
2410 ;}
2411
2412 ;
2413 }
2414 if (@new_child) {
2415 if ($nc_parent and
2416 $nc_parent->
2417 manakai_read_only
2418 ) {
2419
2420
2421 {
2422
2423 local $Error::Depth = $Error::Depth - 1;
2424
2425 {
2426
2427 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#NOMOD_SRC_PARENT', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/replaceChildImpl1+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest';
2428
2429
2430 }
2431
2432
2433 ;}
2434
2435 ;
2436 }
2437 }
2438 }
2439
2440 ## -- Insert at...
2441 my $index = -1; # last
2442
2443
2444 {
2445
2446
2447 # tc:ForAppendChild & tc:ForReplaceChild
2448 if (defined $oldChild) {
2449 if ($oldChild eq $newChild) {
2450
2451
2452 ;
2453
2454
2455 {
2456
2457
2458 {
2459
2460 local $Error::Depth = $Error::Depth - 1;
2461
2462 {
2463
2464 report Message::DOM::DOMCore::ManakaiDOMError -object => $self, '-type' => 'http://suika.fam.cx/~wakaba/archive/2004/dom/tree#replace-by-itself', 'rdata' => $oldChild, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/replaceChildImpl1+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest';
2465
2466
2467 }
2468
2469
2470 ;}
2471
2472 ;
2473
2474
2475
2476 }
2477
2478 ;
2479 }
2480
2481 my $cns = $self->
2482 child_nodes
2483 ;
2484 my $cnsl = @$cns;
2485 C: {
2486 $index = 0;
2487 for my $i (0..($cnsl-1)) {
2488 my $cn = $cns->[$i];
2489 if ($cn eq $oldChild) {
2490 $index += $i;
2491 last C;
2492 } elsif ($cn eq $newChild) {
2493 $index = -1; # offset
2494 }
2495 }
2496
2497
2498 ;
2499
2500
2501 {
2502
2503
2504 {
2505
2506 local $Error::Depth = $Error::Depth - 1;
2507
2508 {
2509
2510 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NOT_FOUND_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#NOT_CHILD_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/replaceChildImpl1+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => 'oldChild', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#node' => $oldChild;
2511
2512
2513 }
2514
2515
2516 ;}
2517
2518 ;
2519
2520
2521
2522 }
2523
2524 ;
2525 } # C
2526 } else { # |oldChild| is not defined
2527
2528
2529 {
2530
2531
2532 {
2533
2534 local $Error::Depth = $Error::Depth - 1;
2535
2536 {
2537
2538 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NOT_FOUND_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#NOT_CHILD_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/replaceChildImpl1+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => 'oldChild', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#node' => $oldChild;
2539
2540
2541 }
2542
2543
2544 ;}
2545
2546 ;
2547
2548
2549
2550 }
2551
2552 ;
2553 }
2554
2555
2556
2557 }
2558
2559 ; # FOR !tc:ForAppendChild
2560
2561 ## -- Removes from parent
2562 if ($nc_parent) {
2563 if ($child_nt ==
2564 11
2565 ) {
2566
2567
2568 {
2569
2570
2571 $newChild->{
2572 'b'
2573 }->{${$newChild->{
2574 'id'
2575 }}}
2576 ->{'child'} = [];
2577
2578
2579 }
2580
2581 ;
2582 } else {
2583 my $v;
2584
2585
2586 {
2587
2588
2589 $v = $nc_parent->{
2590 'b'
2591 }->{${$nc_parent->{
2592 'id'
2593 }}}
2594 ->{'child'};
2595
2596
2597 }
2598
2599 ;
2600 RP: for my $i (0..$#$v) {
2601 my $nodeid = $v->[$i];
2602 if (
2603 (${$new_child[0]->{'id'}} eq ${$nodeid})
2604 ) {
2605 splice @$v, $i, 1, ();
2606 last RP;
2607 }
2608 } # RP
2609 }
2610 }
2611
2612 ## -- Rewrite the |parentNode| properties
2613 for my $nc (@new_child) {
2614
2615
2616 {
2617
2618
2619 $nc->{
2620 'b'
2621 }->{${$nc->{
2622 'id'
2623 }}}
2624 ->{'parent'} = $self->{
2625 'id'
2626 };
2627
2628
2629 }
2630
2631 ;
2632 }
2633
2634 my $children;
2635
2636
2637 {
2638
2639
2640 $children = $self->{
2641 'b'
2642 }->{${$self->{
2643 'id'
2644 }}}
2645 ->{'child'};
2646
2647
2648 }
2649
2650 ;
2651
2652
2653
2654 ;
2655
2656
2657
2658 ;
2659
2660
2661
2662 {
2663
2664
2665 ## -- Replaces the node
2666 splice @$children, $index, 1, map {
2667
2668 $_->{'id'}
2669
2670 } @new_child;
2671
2672
2673 {
2674
2675 CORE::delete
2676 $oldChild->{
2677 'b'
2678 }->{${$oldChild->{
2679 'id'
2680 }}}
2681 ->{'parent'};
2682
2683
2684 }
2685
2686 ;
2687 $r = $oldChild;
2688
2689
2690
2691 }
2692
2693 ;
2694
2695
2696
2697 }
2698
2699
2700 ;}
2701
2702 ;
2703
2704
2705 }
2706
2707 ;
2708
2709
2710 }
2711 $r}
2712 sub attributes ($;$) {
2713 if (@_ == 1) {my ($self) = @_;
2714 my $r;
2715
2716 {
2717
2718
2719 {
2720
2721
2722 $r = bless \\($self),
2723 'Message::DOM::TreeCore::ManakaiDOMAttrMap'
2724 ;
2725
2726
2727 {
2728
2729
2730 $self->{
2731 'b'
2732 }->{${$self->{
2733 'id'
2734 }}}
2735 ->{'hpos'} ||= -1;
2736
2737
2738 }
2739
2740 ;
2741
2742
2743 }
2744
2745 ;
2746
2747
2748 }
2749 $r;
2750 } else {my ($self) = @_;
2751 report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Element::ManakaiDOMElement', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'attributes';
2752 }
2753 }
2754 sub node_name ($;$) {
2755 if (@_ == 1) {my ($self) = @_;
2756 my $r = '';
2757
2758 {
2759
2760 my
2761 $prefix;
2762
2763
2764 {
2765
2766
2767 $prefix = $self->{
2768 'b'
2769 }->{${$self->{
2770 'id'
2771 }}}
2772 ->{'pfx'};
2773
2774
2775 }
2776
2777 ;
2778 my $lname;
2779
2780
2781 {
2782
2783
2784 $lname = $self->{
2785 'b'
2786 }->{${$self->{
2787 'id'
2788 }}}
2789 ->{'ln'};
2790
2791
2792 }
2793
2794 ;
2795 $r = defined $prefix ? $$prefix.':'.$$lname : $$lname;
2796
2797
2798 }
2799 $r;
2800 } else {my ($self) = @_;
2801 report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Element::ManakaiDOMElement', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'node_name';
2802 }
2803 }
2804 sub tag_name ($;$) {
2805 if (@_ == 1) {my ($self) = @_;
2806 my $r = '';
2807
2808 {
2809
2810 my
2811 $prefix;
2812
2813
2814 {
2815
2816
2817 $prefix = $self->{
2818 'b'
2819 }->{${$self->{
2820 'id'
2821 }}}
2822 ->{'pfx'};
2823
2824
2825 }
2826
2827 ;
2828 my $lname;
2829
2830
2831 {
2832
2833
2834 $lname = $self->{
2835 'b'
2836 }->{${$self->{
2837 'id'
2838 }}}
2839 ->{'ln'};
2840
2841
2842 }
2843
2844 ;
2845 $r = defined $prefix ? $$prefix.':'.$$lname : $$lname;
2846
2847
2848 }
2849 $r;
2850 } else {my ($self) = @_;
2851 report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Element::ManakaiDOMElement', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'tag_name';
2852 }
2853 }
2854 sub manakai_append_text ($$) {
2855 my ($self, $string) = @_;
2856 my $r;
2857
2858 {
2859
2860
2861 {
2862
2863 local $Error::Depth = $Error::Depth + 1;
2864
2865 {
2866
2867
2868 my
2869 $lc = $self->
2870 last_child
2871 ;
2872 if (defined $lc and
2873 $lc->
2874 node_type
2875 ==
2876 3
2877 ) {
2878 $lc->
2879 manakai_append_text
2880
2881 (ref $string eq 'SCALAR' ? $string : \$string);
2882 } else {
2883 my $text = $self->
2884 owner_document
2885
2886 ->
2887 create_text_node
2888
2889 (ref $string eq 'SCALAR' ? $$string : $string);
2890 $self->
2891 append_child
2892 ($text);
2893 }
2894 $r = $self;
2895
2896
2897
2898 }
2899
2900
2901 ;}
2902
2903 ;
2904
2905
2906 }
2907 $r}
2908 sub get_feature ($$$) {
2909 my ($self, $feature, $version) = @_;
2910
2911 {
2912
2913
2914 $feature = lc $feature;
2915
2916
2917 }
2918
2919 {
2920
2921
2922 $version = '' unless defined $version;
2923
2924
2925 }
2926 my $r;
2927
2928 {
2929
2930
2931 $feature =~ s/^\+//;
2932
2933
2934 {
2935
2936 if
2937 ($Message::Util::AutoLoad::Registry::Feature->{$feature}->{$version}) {
2938 $r = $self;
2939 }
2940
2941
2942 }
2943
2944 ;
2945 unless (defined $r) {
2946
2947
2948 {
2949
2950 local $Error::Depth = $Error::Depth + 1;
2951
2952 {
2953
2954
2955
2956 $r = $self->SUPER::get_feature ($feature, $version);
2957
2958
2959
2960 }
2961
2962
2963 ;}
2964
2965 ;
2966 }
2967
2968
2969 }
2970 $r}
2971 sub base_uri ($;$) {
2972 if (@_ == 1) {my ($self) = @_;
2973 my $r = '';
2974
2975 {
2976
2977
2978 {
2979
2980
2981 $r = $self->{
2982 'b'
2983 }->{${$self->{
2984 'id'
2985 }}}
2986 ->{'buri'};
2987
2988
2989 }
2990
2991 ;
2992 unless (defined $r) {
2993
2994
2995 {
2996
2997 local $Error::Depth = $Error::Depth + 1;
2998
2999 {
3000
3001
3002 my
3003 $xb = $self->
3004 get_attribute_node_ns
3005
3006 (
3007 'http://www.w3.org/XML/1998/namespace'
3008 , 'base');
3009 unless (defined $xb) {
3010 $xb = $self->
3011 get_attribute_node_ns
3012
3013 (
3014 undef
3015 , 'xml:base');
3016 }
3017 if ($xb) {
3018 $r = $xb->
3019 value
3020 ;
3021 if (
3022 ($r !~ m!\A[^:/?#]+:!)
3023 ) {
3024 my $xbbase = $xb->
3025 base_uri
3026 ;
3027 $r = $self->
3028 owner_document
3029
3030 ->
3031 implementation
3032
3033 ->
3034 create_uri_reference
3035
3036 ($r)
3037 ->
3038 get_absolute_reference
3039
3040 ($xbbase)
3041 ->
3042 uri_reference
3043 if
3044 defined $xbbase;
3045 }
3046 } else {
3047 my $pe = $self->
3048 parent_node
3049 ;
3050 W: {
3051 while (defined $pe) {
3052 my $nt = $pe->
3053 node_type
3054 ;
3055 if ($nt ==
3056 1 or
3057
3058 $nt ==
3059 9 or
3060
3061 $nt ==
3062 11 or
3063
3064 $nt ==
3065 6
3066 ) {
3067 $r = $pe->
3068 base_uri
3069 ;
3070 last W;
3071 } elsif ($nt ==
3072 5
3073 ) {
3074 if ($pe->
3075 manakai_external
3076 ) {
3077 $r = $pe->
3078 manakai_entity_base_uri
3079 ;
3080 last W;
3081 }
3082 }
3083 $pe = $pe->
3084 parent_node
3085 ;
3086 }
3087 if ($pe) {
3088 $r = $pe->
3089 base_uri
3090 ;
3091 } else {
3092 $r = $self->
3093 owner_document
3094 ->
3095 base_uri
3096 ;
3097 }
3098 } # W
3099 }
3100
3101
3102
3103 }
3104
3105
3106 ;}
3107
3108 ;
3109 }
3110
3111
3112 }
3113 $r;
3114 } else {my ($self) = @_;
3115 report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Element::ManakaiDOMElement', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'base_uri';
3116 }
3117 }
3118 sub get_attribute ($$) {
3119 my ($self, $name) = @_;
3120 my $r = '';
3121
3122 {
3123
3124 my
3125 $node;
3126
3127
3128 {
3129
3130 my
3131 $__attr;
3132
3133
3134 {
3135
3136
3137 $__attr = $self->{
3138 'b'
3139 }->{${$self->{
3140 'id'
3141 }}}
3142 ->{'attr'};
3143
3144
3145 }
3146
3147 ;
3148
3149 ## Note that we no longer support DOM Level 1 nodes.
3150
3151 ## If an attribute's qualified name is equal to
3152 ## the requested name, then the node is the answer.
3153
3154 ## Note that if there is a namespace ill-formed attribute,
3155 ## the result is not the expected one. For example,
3156 ## if an |xmlns| attribute in the |http://www.w3.org/2000/xmlns/|
3157 ## namespace has non-NULL |prefix|, a request to get |xmlns|
3158 ## attribute will not return that node.
3159
3160 ## |sort|ing is required so that every |getAttribute|, |setAttribute|,
3161 ## |hasAttribute|, |removeAttribute|, or any other namespace unaware
3162 ## methods operates on the same node even if there is
3163 ## multiple nodes with the same qualified name.
3164
3165 NS: for my $__ns (sort {$a cmp $b} keys %$__attr) {
3166 for my $__ln (sort {$a cmp $b} keys %{$__attr->{$__ns}}) {
3167 my $__node;
3168
3169
3170 {
3171
3172
3173 $__node = ${($self->{'b'})->{${$__attr->{$__ns}->{$__ln}}}->{
3174 'cls'
3175 }}->___create_node_ref ({
3176
3177 'id'
3178 => $__attr->{$__ns}->{$__ln},
3179
3180 'b'
3181 => ($self->{'b'}),
3182 }, {
3183 });
3184 ($self->{'b'})->{${$__attr->{$__ns}->{$__ln}}}->{
3185 'rc'
3186 }++;
3187
3188
3189 }
3190
3191 ;
3192 if ($__node->
3193 node_name eq
3194 $name) {
3195
3196
3197 {
3198
3199
3200 $node = $__node;
3201
3202
3203
3204 }
3205
3206 ;
3207
3208
3209 ;
3210 last NS;
3211 }
3212 } # ln
3213 } # NS
3214
3215
3216 }
3217
3218 ;
3219 if (defined $node) {
3220 $r = $node->
3221 value
3222 ;
3223 } else {
3224 $r =
3225 undef
3226 ;
3227 }
3228
3229
3230 }
3231 $r}
3232 sub get_attribute_ns ($$$) {
3233 my ($self, $namespaceURI, $localName) = @_;
3234
3235 {
3236
3237 if
3238 (CORE::defined $namespaceURI and CORE::length $namespaceURI == 0) {
3239 require Message::DOM::DOMMain;
3240
3241 report Message::DOM::DOMCore::ManakaiDOMError -object => $self, '-type' => 'http://suika.fam.cx/~wakaba/archive/2004/dom/main#empty-namespace-uri', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:tag:suika.fam.cx,2005-09:1165118814:1861:wAUT122229+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest';
3242
3243 ;
3244
3245
3246
3247 {
3248
3249
3250 $namespaceURI = undef;
3251
3252
3253
3254 }
3255
3256 ;
3257 }
3258
3259
3260 }
3261 my $r = '';
3262
3263 {
3264
3265 my
3266 $node;
3267
3268
3269 {
3270
3271 my
3272 $__attrs;
3273
3274
3275 {
3276
3277
3278 $__attrs = $self->{
3279 'b'
3280 }->{${$self->{
3281 'id'
3282 }}}
3283 ->{'attr'};
3284
3285
3286 }
3287
3288 ;
3289 if (defined $__attrs->{defined $namespaceURI ? $namespaceURI : ''}
3290 ->{$localName}) {
3291
3292
3293 {
3294
3295
3296 $node = ${($self->{'b'})->{${$__attrs->{defined $namespaceURI ? $namespaceURI : ''}
3297 ->{$localName}}}->{
3298 'cls'
3299 }}->___create_node_ref ({
3300
3301 'id'
3302 => $__attrs->{defined $namespaceURI ? $namespaceURI : ''}
3303 ->{$localName},
3304
3305 'b'
3306 => ($self->{'b'}),
3307 }, {
3308 });
3309 ($self->{'b'})->{${$__attrs->{defined $namespaceURI ? $namespaceURI : ''}
3310 ->{$localName}}}->{
3311 'rc'
3312 }++;
3313
3314
3315 }
3316
3317 ;
3318 }
3319
3320
3321 }
3322
3323 ;
3324 if (defined $node) {
3325 $r = $node->
3326 value
3327 ;
3328 } else {
3329 $r =
3330 undef
3331 ;
3332 }
3333
3334
3335 }
3336 $r}
3337 sub get_attribute_node ($$) {
3338 my ($self, $name) = @_;
3339 my $r;
3340
3341 {
3342
3343
3344 {
3345
3346 my
3347 $__attr;
3348
3349
3350 {
3351
3352
3353 $__attr = $self->{
3354 'b'
3355 }->{${$self->{
3356 'id'
3357 }}}
3358 ->{'attr'};
3359
3360
3361 }
3362
3363 ;
3364
3365 ## Note that we no longer support DOM Level 1 nodes.
3366
3367 ## If an attribute's qualified name is equal to
3368 ## the requested name, then the node is the answer.
3369
3370 ## Note that if there is a namespace ill-formed attribute,
3371 ## the result is not the expected one. For example,
3372 ## if an |xmlns| attribute in the |http://www.w3.org/2000/xmlns/|
3373 ## namespace has non-NULL |prefix|, a request to get |xmlns|
3374 ## attribute will not return that node.
3375
3376 ## |sort|ing is required so that every |getAttribute|, |setAttribute|,
3377 ## |hasAttribute|, |removeAttribute|, or any other namespace unaware
3378 ## methods operates on the same node even if there is
3379 ## multiple nodes with the same qualified name.
3380
3381 NS: for my $__ns (sort {$a cmp $b} keys %$__attr) {
3382 for my $__ln (sort {$a cmp $b} keys %{$__attr->{$__ns}}) {
3383 my $__node;
3384
3385
3386 {
3387
3388
3389 $__node = ${($self->{'b'})->{${$__attr->{$__ns}->{$__ln}}}->{
3390 'cls'
3391 }}->___create_node_ref ({
3392
3393 'id'
3394 => $__attr->{$__ns}->{$__ln},
3395
3396 'b'
3397 => ($self->{'b'}),
3398 }, {
3399 });
3400 ($self->{'b'})->{${$__attr->{$__ns}->{$__ln}}}->{
3401 'rc'
3402 }++;
3403
3404
3405 }
3406
3407 ;
3408 if ($__node->
3409 node_name eq
3410 $name) {
3411
3412
3413 {
3414
3415
3416 $r = $__node;
3417
3418
3419
3420 }
3421
3422 ;
3423
3424
3425 ;
3426 last NS;
3427 }
3428 } # ln
3429 } # NS
3430
3431
3432 }
3433
3434 ;
3435
3436
3437 }
3438 $r}
3439 sub get_attribute_node_ns ($$$) {
3440 my ($self, $namespaceURI, $localName) = @_;
3441
3442 {
3443
3444 if
3445 (CORE::defined $namespaceURI and CORE::length $namespaceURI == 0) {
3446 require Message::DOM::DOMMain;
3447
3448 report Message::DOM::DOMCore::ManakaiDOMError -object => $self, '-type' => 'http://suika.fam.cx/~wakaba/archive/2004/dom/main#empty-namespace-uri', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:tag:suika.fam.cx,2005-09:1165118814:1861:wAUT122229+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest';
3449
3450 ;
3451
3452
3453
3454 {
3455
3456
3457 $namespaceURI = undef;
3458
3459
3460
3461 }
3462
3463 ;
3464 }
3465
3466
3467 }
3468 my $r;
3469
3470 {
3471
3472
3473 {
3474
3475 my
3476 $__attrs;
3477
3478
3479 {
3480
3481
3482 $__attrs = $self->{
3483 'b'
3484 }->{${$self->{
3485 'id'
3486 }}}
3487 ->{'attr'};
3488
3489
3490 }
3491
3492 ;
3493 if (defined $__attrs->{defined $namespaceURI ? $namespaceURI : ''}
3494 ->{$localName}) {
3495
3496
3497 {
3498
3499
3500 $r = ${($self->{'b'})->{${$__attrs->{defined $namespaceURI ? $namespaceURI : ''}
3501 ->{$localName}}}->{
3502 'cls'
3503 }}->___create_node_ref ({
3504
3505 'id'
3506 => $__attrs->{defined $namespaceURI ? $namespaceURI : ''}
3507 ->{$localName},
3508
3509 'b'
3510 => ($self->{'b'}),
3511 }, {
3512 });
3513 ($self->{'b'})->{${$__attrs->{defined $namespaceURI ? $namespaceURI : ''}
3514 ->{$localName}}}->{
3515 'rc'
3516 }++;
3517
3518
3519 }
3520
3521 ;
3522 }
3523
3524
3525 }
3526
3527 ;
3528
3529
3530 }
3531 $r}
3532 sub has_attribute ($$) {
3533 my ($self, $name) = @_;
3534 my $r = 0;
3535
3536 {
3537
3538 my
3539 $node;
3540
3541
3542 {
3543
3544 my
3545 $__attr;
3546
3547
3548 {
3549
3550
3551 $__attr = $self->{
3552 'b'
3553 }->{${$self->{
3554 'id'
3555 }}}
3556 ->{'attr'};
3557
3558
3559 }
3560
3561 ;
3562
3563 ## Note that we no longer support DOM Level 1 nodes.
3564
3565 ## If an attribute's qualified name is equal to
3566 ## the requested name, then the node is the answer.
3567
3568 ## Note that if there is a namespace ill-formed attribute,
3569 ## the result is not the expected one. For example,
3570 ## if an |xmlns| attribute in the |http://www.w3.org/2000/xmlns/|
3571 ## namespace has non-NULL |prefix|, a request to get |xmlns|
3572 ## attribute will not return that node.
3573
3574 ## |sort|ing is required so that every |getAttribute|, |setAttribute|,
3575 ## |hasAttribute|, |removeAttribute|, or any other namespace unaware
3576 ## methods operates on the same node even if there is
3577 ## multiple nodes with the same qualified name.
3578
3579 NS: for my $__ns (sort {$a cmp $b} keys %$__attr) {
3580 for my $__ln (sort {$a cmp $b} keys %{$__attr->{$__ns}}) {
3581 my $__node;
3582
3583
3584 {
3585
3586
3587 $__node = ${($self->{'b'})->{${$__attr->{$__ns}->{$__ln}}}->{
3588 'cls'
3589 }}->___create_node_ref ({
3590
3591 'id'
3592 => $__attr->{$__ns}->{$__ln},
3593
3594 'b'
3595 => ($self->{'b'}),
3596 }, {
3597 });
3598 ($self->{'b'})->{${$__attr->{$__ns}->{$__ln}}}->{
3599 'rc'
3600 }++;
3601
3602
3603 }
3604
3605 ;
3606 if ($__node->
3607 node_name eq
3608 $name) {
3609
3610
3611 {
3612
3613
3614 $node = $__node;
3615
3616
3617
3618 }
3619
3620 ;
3621
3622
3623 ;
3624 last NS;
3625 }
3626 } # ln
3627 } # NS
3628
3629
3630 }
3631
3632 ;
3633 $r = defined $node;
3634
3635
3636 }
3637 $r}
3638 sub has_attribute_ns ($$$) {
3639 my ($self, $namespaceURI, $localName) = @_;
3640
3641 {
3642
3643 if
3644 (CORE::defined $namespaceURI and CORE::length $namespaceURI == 0) {
3645 require Message::DOM::DOMMain;
3646
3647 report Message::DOM::DOMCore::ManakaiDOMError -object => $self, '-type' => 'http://suika.fam.cx/~wakaba/archive/2004/dom/main#empty-namespace-uri', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:tag:suika.fam.cx,2005-09:1165118814:1861:wAUT122229+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest';
3648
3649 ;
3650
3651
3652
3653 {
3654
3655
3656 $namespaceURI = undef;
3657
3658
3659
3660 }
3661
3662 ;
3663 }
3664
3665
3666 }
3667 my $r = 0;
3668
3669 {
3670
3671 my
3672 $node;
3673
3674
3675 {
3676
3677 my
3678 $__attrs;
3679
3680
3681 {
3682
3683
3684 $__attrs = $self->{
3685 'b'
3686 }->{${$self->{
3687 'id'
3688 }}}
3689 ->{'attr'};
3690
3691
3692 }
3693
3694 ;
3695 if (defined $__attrs->{defined $namespaceURI ? $namespaceURI : ''}
3696 ->{$localName}) {
3697
3698
3699 {
3700
3701
3702 $node = ${($self->{'b'})->{${$__attrs->{defined $namespaceURI ? $namespaceURI : ''}
3703 ->{$localName}}}->{
3704 'cls'
3705 }}->___create_node_ref ({
3706
3707 'id'
3708 => $__attrs->{defined $namespaceURI ? $namespaceURI : ''}
3709 ->{$localName},
3710
3711 'b'
3712 => ($self->{'b'}),
3713 }, {
3714 });
3715 ($self->{'b'})->{${$__attrs->{defined $namespaceURI ? $namespaceURI : ''}
3716 ->{$localName}}}->{
3717 'rc'
3718 }++;
3719
3720
3721 }
3722
3723 ;
3724 }
3725
3726
3727 }
3728
3729 ;
3730 $r = defined $node;
3731
3732
3733 }
3734 $r}
3735 sub set_attribute ($$$) {
3736 my ($self, $name, $value) = @_;
3737
3738 {
3739
3740 my
3741 $od = $self->
3742 owner_document
3743 ;
3744 if ($od->
3745 strict_error_checking
3746 ) {
3747 if ($self->
3748 manakai_read_only
3749 ) {
3750
3751 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'set_attribute', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#NOMOD_THIS', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Element::ManakaiDOMElement';
3752
3753 ;
3754 }
3755 my $version = $od->
3756 xml_version
3757 ;
3758
3759
3760 {
3761
3762 if
3763 (defined $name) {
3764
3765
3766 {
3767
3768 if
3769 (((not defined $version or $version eq '1.0') and
3770 not
3771 ($name =~ /\A\p{InXML_NameStartChar10}\p{InXMLNameChar10}*\z/)
3772 ) or
3773 (defined $version and $version eq '1.1' and
3774 not
3775 ($name =~ /\A\p{InXMLNameStartChar11}\p{InXMLNameChar11}*\z/)
3776 )) {
3777
3778 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'INVALID_CHARACTER_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#MDOM_BAD_NAME', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#name' => $name, 'http://www.w3.org/2001/04/infoset#version' => $version, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2004/dom/main%23ensureXMLName+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => '$INPUT_PARAM_NAME';
3779
3780 ;
3781 }
3782
3783
3784
3785 }
3786
3787 ;
3788
3789
3790 ;
3791 }
3792
3793
3794 }
3795
3796 ;
3797 }
3798
3799 my $__anode;
3800
3801
3802 {
3803
3804 my
3805 $__attr;
3806
3807
3808 {
3809
3810
3811 $__attr = $self->{
3812 'b'
3813 }->{${$self->{
3814 'id'
3815 }}}
3816 ->{'attr'};
3817
3818
3819 }
3820
3821 ;
3822
3823 ## Note that we no longer support DOM Level 1 nodes.
3824
3825 ## If an attribute's qualified name is equal to
3826 ## the requested name, then the node is the answer.
3827
3828 ## Note that if there is a namespace ill-formed attribute,
3829 ## the result is not the expected one. For example,
3830 ## if an |xmlns| attribute in the |http://www.w3.org/2000/xmlns/|
3831 ## namespace has non-NULL |prefix|, a request to get |xmlns|
3832 ## attribute will not return that node.
3833
3834 ## |sort|ing is required so that every |getAttribute|, |setAttribute|,
3835 ## |hasAttribute|, |removeAttribute|, or any other namespace unaware
3836 ## methods operates on the same node even if there is
3837 ## multiple nodes with the same qualified name.
3838
3839 NS: for my $__ns (sort {$a cmp $b} keys %$__attr) {
3840 for my $__ln (sort {$a cmp $b} keys %{$__attr->{$__ns}}) {
3841 my $__node;
3842
3843
3844 {
3845
3846
3847 $__node = ${($self->{'b'})->{${$__attr->{$__ns}->{$__ln}}}->{
3848 'cls'
3849 }}->___create_node_ref ({
3850
3851 'id'
3852 => $__attr->{$__ns}->{$__ln},
3853
3854 'b'
3855 => ($self->{'b'}),
3856 }, {
3857 });
3858 ($self->{'b'})->{${$__attr->{$__ns}->{$__ln}}}->{
3859 'rc'
3860 }++;
3861
3862
3863 }
3864
3865 ;
3866 if ($__node->
3867 node_name eq
3868 $name) {
3869
3870
3871 {
3872
3873
3874 $__anode = $__node;
3875
3876
3877
3878 }
3879
3880 ;
3881
3882
3883 ;
3884 last NS;
3885 }
3886 } # ln
3887 } # NS
3888
3889
3890 }
3891
3892 ;
3893 if (defined $__anode) { ## There is already a node with such a |name|
3894 if ($__anode->
3895 manakai_read_only
3896 ) {
3897
3898 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'set_attribute', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#NOMOD_ATTR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Element::ManakaiDOMElement', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => 'name', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#node' => $__anode;
3899
3900 ;
3901 }
3902 } else { ## There is no such attribute
3903
3904
3905 {
3906
3907 local $Error::Depth = $Error::Depth + 1;
3908
3909 {
3910
3911
3912
3913 $__anode = $od->
3914 create_attribute
3915 ($name);
3916 my $__attrs;
3917
3918
3919 {
3920
3921
3922 $__attrs = $self->{
3923 'b'
3924 }->{${$self->{
3925 'id'
3926 }}}
3927 ->{'attr'};
3928
3929
3930 }
3931
3932 ;
3933 $__attrs->{''}->{$name}
3934 =
3935 $__anode->{'id'}
3936 ;
3937
3938
3939 {
3940
3941
3942 $__anode->{
3943 'b'
3944 }->{${$__anode->{
3945 'id'
3946 }}}
3947 ->{'owner'} = $self->{
3948 'id'
3949 };
3950
3951
3952 }
3953
3954 ;
3955
3956
3957
3958 }
3959
3960
3961 ;}
3962
3963 ;
3964
3965
3966 {
3967
3968
3969 ## NOTE: The |cfg:xml-id| configuration parameter does not matter
3970 ## since it can be typed in the |createAttribute| method.
3971
3972
3973
3974 {
3975
3976 local $Error::Depth = $Error::Depth + 1;
3977
3978 {
3979
3980
3981 if
3982 ($od->
3983 dom_config
3984
3985 ->
3986 get_parameter
3987
3988 (
3989 'http://suika.fam.cx/www/2006/dom-config/dtd-attribute-type'
3990 )) {
3991 my $__st_doctype = $od->
3992 doctype
3993 ;
3994 $__st_doctype = $__st_doctype->
3995 get_feature
3996
3997 (
3998 'http://suika.fam.cx/www/2006/feature/XDoctype'
3999 => '3.0')
4000 if defined $__st_doctype;
4001 if (defined $__st_doctype) {
4002 my $__st_et = $__st_doctype->
4003 get_element_type_definition_node
4004
4005 ($self->
4006 node_name
4007 );
4008 if (defined $__st_et) {
4009 my $__st_at = $__st_et->
4010 get_attribute_definition_node
4011
4012 ($name);
4013 if (defined $__st_at) {
4014 $__anode->
4015 manakai_attribute_type
4016
4017 ($__st_at->
4018 declared_type
4019 );
4020 }
4021 }
4022 }
4023 }
4024
4025
4026
4027 }
4028
4029
4030 ;}
4031
4032 ;
4033
4034
4035 }
4036
4037 ;
4038 }
4039
4040
4041 {
4042
4043 local $Error::Depth = $Error::Depth + 1;
4044
4045 {
4046
4047
4048
4049 $__anode->
4050 value
4051 ($value);
4052 $__anode->
4053 specified
4054 (
4055 1
4056 );
4057
4058
4059
4060 }
4061
4062
4063 ;}
4064
4065 ;
4066
4067
4068 }
4069 }
4070 sub set_attribute_ns ($$$$) {
4071 my ($self, $namespaceURI, $qualifiedName, $value) = @_;
4072
4073 {
4074
4075 if
4076 (CORE::defined $namespaceURI and CORE::length $namespaceURI == 0) {
4077 require Message::DOM::DOMMain;
4078
4079 report Message::DOM::DOMCore::ManakaiDOMError -object => $self, '-type' => 'http://suika.fam.cx/~wakaba/archive/2004/dom/main#empty-namespace-uri', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:tag:suika.fam.cx,2005-09:1165118814:1861:wAUT122229+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest';
4080
4081 ;
4082
4083
4084
4085 {
4086
4087
4088 $namespaceURI = undef;
4089
4090
4091
4092 }
4093
4094 ;
4095 }
4096
4097
4098 }
4099
4100 {
4101
4102 my
4103 ($prefix, $localName) = ref $qualifiedName eq 'ARRAY'
4104 ? @$qualifiedName
4105 : split /:/, $qualifiedName, 2;
4106 ($prefix, $localName) = (
4107 undef
4108 , $prefix) unless defined $localName;
4109
4110 my $od = $self->
4111 owner_document
4112 ;
4113 if ($od->
4114 strict_error_checking
4115 ) {
4116 if ($self->
4117 manakai_read_only
4118 ) {
4119
4120 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'set_attribute_ns', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#NOMOD_THIS', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Element::ManakaiDOMElement';
4121
4122 ;
4123 }
4124 my $version = $od->
4125 xml_version
4126 ;
4127 $qualifiedName = defined $prefix ? $prefix.':'.$localName
4128 : $localName;
4129
4130
4131 {
4132
4133 if
4134 (defined $version and $version eq '1.1') {
4135 unless (
4136 ($qualifiedName =~ /\A\p{InXMLNameStartChar11}\p{InXMLNameChar11}*\z/)
4137 ) {
4138
4139 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'INVALID_CHARACTER_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#MDOM_BAD_NAME', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#name' => $qualifiedName, 'http://www.w3.org/2001/04/infoset#version' => '1.1', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2004/dom/main%23ensureXMLQName+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => '$INPUT_NAME';
4140
4141 ;
4142 }
4143 unless (
4144 ($qualifiedName =~ /\A\p{InXMLNCNameStartChar11}\p{InXMLNCNameChar11}*(?::\p{InXMLNCNameStartChar11}\p{InXMLNCNameChar11}*)?\z/)
4145 ) {
4146
4147 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NAMESPACE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#MDOM_NS_MALFORMED_QNAME', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#name' => $qualifiedName, 'http://www.w3.org/2001/04/infoset#version' => '1.1', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2004/dom/main%23ensureXMLQName+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => '$INPUT_NAME';
4148
4149 ;
4150 }
4151 } else {
4152 unless (
4153 ($qualifiedName =~ /\A\p{InXML_NameStartChar10}\p{InXMLNameChar10}*\z/)
4154 ) {
4155
4156 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'INVALID_CHARACTER_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#MDOM_BAD_NAME', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#name' => $qualifiedName, 'http://www.w3.org/2001/04/infoset#version' => $version, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2004/dom/main%23ensureXMLQName+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => '$INPUT_NAME';
4157
4158 ;
4159 }
4160 unless (
4161 ($qualifiedName =~ /\A\p{InXML_NCNameStartChar10}\p{InXMLNCNameChar10}*(?::\p{InXML_NCNameStartChar10}\p{InXMLNCNameChar10}*)?\z/)
4162 ) {
4163
4164 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NAMESPACE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#MDOM_NS_MALFORMED_QNAME', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#name' => $qualifiedName, 'http://www.w3.org/2001/04/infoset#version' => $version, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2004/dom/main%23ensureXMLQName+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => '$INPUT_NAME';
4165
4166 ;
4167 }
4168 }
4169
4170
4171 }
4172
4173 ;
4174
4175
4176 {
4177
4178 if
4179 (defined $prefix) {
4180 if (not defined $namespaceURI) {
4181
4182 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NAMESPACE_ERR', 'http://www.w3.org/2001/04/infoset#prefix' => $prefix, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#MDOM_NS_PREFIX_WITH_NULL_URI', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2004/dom/main%23checkXMLNamesQName+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest';
4183
4184 ;
4185 } elsif ($prefix eq 'xml' and $namespaceURI ne
4186 'http://www.w3.org/XML/1998/namespace'
4187 ) {
4188
4189 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NAMESPACE_ERR', 'http://www.w3.org/2001/04/infoset#namespaceName' => $namespaceURI, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#MDOM_NS_XML_WITH_OTHER_URI', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2004/dom/main%23checkXMLNamesQName+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest';
4190
4191 ;
4192 } elsif ($prefix eq 'xmlns' and $namespaceURI ne
4193 'http://www.w3.org/2000/xmlns/'
4194 ) {
4195
4196 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NAMESPACE_ERR', 'http://www.w3.org/2001/04/infoset#namespaceName' => $namespaceURI, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#MDOM_NS_XMLNS_WITH_OTHER_URI', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2004/dom/main%23checkXMLNamesQName+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest';
4197
4198 ;
4199 } elsif ($namespaceURI eq
4200 'http://www.w3.org/XML/1998/namespace' and
4201 $prefix ne 'xml') {
4202
4203 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NAMESPACE_ERR', 'http://www.w3.org/2001/04/infoset#prefix' => $prefix, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#MDOM_NS_OTHER_WITH_XML_URI', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2004/dom/main%23checkXMLNamesQName+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest';
4204
4205 ;
4206 } elsif ($namespaceURI eq
4207 'http://www.w3.org/2000/xmlns/' and
4208 $prefix ne 'xmlns') {
4209
4210 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NAMESPACE_ERR', 'http://www.w3.org/2001/04/infoset#prefix' => $prefix, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#MDOM_NS_OTHER_WITH_XMLNS_URI', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2004/dom/main%23checkXMLNamesQName+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest';
4211
4212 ;
4213 }
4214 } else { ## No prefix
4215 if (not defined $namespaceURI) {
4216 #
4217 } elsif ($namespaceURI eq
4218 'http://www.w3.org/2000/xmlns/' and
4219 $localName ne 'xmlns') {
4220
4221 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NAMESPACE_ERR', 'http://www.w3.org/2001/04/infoset#prefix' => undef, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#MDOM_NS_OTHER_WITH_XMLNS_URI', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2004/dom/main%23checkXMLNamesQName+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest';
4222
4223 ;
4224 }
4225 }
4226
4227
4228 }
4229
4230 ;
4231 }
4232
4233
4234 {
4235
4236 my
4237 $__anode;
4238
4239
4240 {
4241
4242 my
4243 $__attrs;
4244
4245
4246 {
4247
4248
4249 $__attrs = $self->{
4250 'b'
4251 }->{${$self->{
4252 'id'
4253 }}}
4254 ->{'attr'};
4255
4256
4257 }
4258
4259 ;
4260 if (defined $__attrs->{defined $namespaceURI ? $namespaceURI : ''}
4261 ->{$localName}) {
4262
4263
4264 {
4265
4266
4267 $__anode = ${($self->{'b'})->{${$__attrs->{defined $namespaceURI ? $namespaceURI : ''}
4268 ->{$localName}}}->{
4269 'cls'
4270 }}->___create_node_ref ({
4271
4272 'id'
4273 => $__attrs->{defined $namespaceURI ? $namespaceURI : ''}
4274 ->{$localName},
4275
4276 'b'
4277 => ($self->{'b'}),
4278 }, {
4279 });
4280 ($self->{'b'})->{${$__attrs->{defined $namespaceURI ? $namespaceURI : ''}
4281 ->{$localName}}}->{
4282 'rc'
4283 }++;
4284
4285
4286 }
4287
4288 ;
4289 }
4290
4291
4292 }
4293
4294 ;
4295 if (defined $__anode) { ## There is already a node with such a |name|
4296 if ($__anode->
4297 manakai_read_only
4298 ) {
4299
4300 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#NOMOD_ATTR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/setAttrValueNS+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#node' => $__anode;
4301
4302 ;
4303 }
4304 $__anode->
4305 prefix
4306 ($prefix) if defined $prefix;
4307 ## ISSUE: Should NULL be allowed here with |strictErrorChecking| off?
4308 } else { ## There is no such attribute
4309
4310
4311 {
4312
4313 local $Error::Depth = $Error::Depth + 1;
4314
4315 {
4316
4317
4318
4319 $__anode = $od->
4320 create_attribute_ns
4321
4322 ($namespaceURI, [$prefix, $localName]);
4323 my $__attrs;
4324
4325
4326 {
4327
4328
4329 $__attrs = $self->{
4330 'b'
4331 }->{${$self->{
4332 'id'
4333 }}}
4334 ->{'attr'};
4335
4336
4337 }
4338
4339 ;
4340 $__attrs->{defined $namespaceURI ? $namespaceURI : ''}->{$localName}
4341 =
4342 $__anode->{'id'}
4343 ;
4344
4345
4346 {
4347
4348
4349 $__anode->{
4350 'b'
4351 }->{${$__anode->{
4352 'id'
4353 }}}
4354 ->{'owner'} = $self->{
4355 'id'
4356 };
4357
4358
4359 }
4360
4361 ;
4362
4363
4364
4365 }
4366
4367
4368 ;}
4369
4370 ;
4371
4372
4373 {
4374
4375
4376 ## NOTE: The |cfg:xml-id| configuration parameter does not matter
4377 ## since it can be typed in the |createAttribute| method.
4378
4379
4380
4381 {
4382
4383 local $Error::Depth = $Error::Depth + 1;
4384
4385 {
4386
4387
4388 if
4389 ($od->
4390 dom_config
4391
4392 ->
4393 get_parameter
4394
4395 (
4396 'http://suika.fam.cx/www/2006/dom-config/dtd-attribute-type'
4397 )) {
4398 my $__st_doctype = $od->
4399 doctype
4400 ;
4401 $__st_doctype = $__st_doctype->
4402 get_feature
4403
4404 (
4405 'http://suika.fam.cx/www/2006/feature/XDoctype'
4406 => '3.0')
4407 if defined $__st_doctype;
4408 if (defined $__st_doctype) {
4409 my $__st_et = $__st_doctype->
4410 get_element_type_definition_node
4411
4412 ($self->
4413 node_name
4414 );
4415 if (defined $__st_et) {
4416 my $__st_at = $__st_et->
4417 get_attribute_definition_node
4418
4419 (defined $prefix ? $prefix.':'.$localName
4420 : $localName);
4421 if (defined $__st_at) {
4422 $__anode->
4423 manakai_attribute_type
4424
4425 ($__st_at->
4426 declared_type
4427 );
4428 }
4429 }
4430 }
4431 }
4432
4433
4434
4435 }
4436
4437
4438 ;}
4439
4440 ;
4441
4442
4443 }
4444
4445 ;
4446 }
4447
4448
4449 {
4450
4451 local $Error::Depth = $Error::Depth + 1;
4452
4453 {
4454
4455
4456
4457 $__anode->
4458 value
4459 (defined $value ? $value : '');
4460 $__anode->
4461 specified
4462 (
4463 1
4464 );
4465
4466
4467
4468 }
4469
4470
4471 ;}
4472
4473 ;
4474
4475
4476 }
4477
4478 ;
4479
4480
4481 }
4482 }
4483 sub set_attribute_node ($$) {
4484 my ($self, $newAttr) = @_;
4485 my $r;
4486
4487 {
4488
4489 my
4490 $self_od = $self->
4491 owner_document
4492 ;
4493 my $strict = $self_od->
4494 strict_error_checking
4495 ;
4496 if ($strict and
4497 not $self_od eq $newAttr->
4498 owner_document
4499 ) {
4500
4501 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'WRONG_DOCUMENT_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'set_attribute_node', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#DIFFERENT_DOCUMENT_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Element::ManakaiDOMElement', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => 'newAttr', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#node' => $newAttr;
4502
4503 ;
4504 }
4505
4506 my $nsuri = $newAttr->
4507 namespace_uri
4508 ;
4509 $nsuri = '' unless defined $nsuri;
4510 my $ln = $newAttr->
4511 local_name
4512 ;
4513 my $attrs;
4514
4515
4516 {
4517
4518
4519 $attrs = $self->{
4520 'b'
4521 }->{${$self->{
4522 'id'
4523 }}}
4524 ->{'attr'};
4525
4526
4527 }
4528
4529 ;
4530 my $current;
4531 if (defined $attrs->{$nsuri}->{$ln}) {
4532
4533
4534 {
4535
4536
4537 $current = ${($self->{'b'})->{${$attrs->{$nsuri}->{$ln}}}->{
4538 'cls'
4539 }}->___create_node_ref ({
4540
4541 'id'
4542 => $attrs->{$nsuri}->{$ln},
4543
4544 'b'
4545 => ($self->{'b'}),
4546 }, {
4547 });
4548 ($self->{'b'})->{${$attrs->{$nsuri}->{$ln}}}->{
4549 'rc'
4550 }++;
4551
4552
4553 }
4554
4555 ;
4556 }
4557
4558 if (defined $newAttr->
4559 owner_element
4560 ) {
4561 if (defined $current and $current eq $newAttr) {
4562
4563 report Message::DOM::DOMCore::ManakaiDOMError -object => $self, '-type' => 'http://suika.fam.cx/~wakaba/archive/2004/dom/tree#replace-by-itself', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'set_attribute_node', 'rdata' => $newAttr, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Element::ManakaiDOMElement';
4564
4565 ;
4566 ## No return value
4567 } else {
4568
4569 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'INUSE_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'set_attribute_node', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Element::ManakaiDOMElement', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => 'newAttr', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#node' => $newAttr;
4570
4571 ;
4572 }
4573 } else { # not in use
4574 if ($strict and $self->
4575 manakai_read_only
4576 ) {
4577
4578 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'set_attribute_node', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#NOMOD_THIS', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Element::ManakaiDOMElement';
4579
4580 ;
4581 }
4582
4583 $attrs->{$nsuri}->{$ln} =
4584 $newAttr->{'id'}
4585 ;
4586
4587
4588 {
4589
4590
4591 $newAttr->{
4592 'b'
4593 }->{${$newAttr->{
4594 'id'
4595 }}}
4596 ->{'owner'} = $self->{
4597 'id'
4598 };
4599
4600
4601 }
4602
4603 ;
4604 $newAttr->
4605 specified
4606 (
4607 1
4608 );
4609
4610 if (defined $current) {
4611
4612
4613 {
4614
4615 CORE::delete
4616 $current->{
4617 'b'
4618 }->{${$current->{
4619 'id'
4620 }}}
4621 ->{'owner'};
4622
4623
4624 }
4625
4626 ;
4627 $r = $current;
4628 }
4629 }
4630
4631
4632 }
4633 $r}
4634 sub set_attribute_node_ns ($$) {
4635 my ($self, $newAttr) = @_;
4636 my $r;
4637
4638 {
4639
4640 my
4641 $self_od = $self->
4642 owner_document
4643 ;
4644 my $strict = $self_od->
4645 strict_error_checking
4646 ;
4647 if ($strict and
4648 not $self_od eq $newAttr->
4649 owner_document
4650 ) {
4651
4652 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'WRONG_DOCUMENT_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'set_attribute_node', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#DIFFERENT_DOCUMENT_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Element::ManakaiDOMElement', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => 'newAttr', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#node' => $newAttr;
4653
4654 ;
4655 }
4656
4657 my $nsuri = $newAttr->
4658 namespace_uri
4659 ;
4660 $nsuri = '' unless defined $nsuri;
4661 my $ln = $newAttr->
4662 local_name
4663 ;
4664 my $attrs;
4665
4666
4667 {
4668
4669
4670 $attrs = $self->{
4671 'b'
4672 }->{${$self->{
4673 'id'
4674 }}}
4675 ->{'attr'};
4676
4677
4678 }
4679
4680 ;
4681 my $current;
4682 if (defined $attrs->{$nsuri}->{$ln}) {
4683
4684
4685 {
4686
4687
4688 $current = ${($self->{'b'})->{${$attrs->{$nsuri}->{$ln}}}->{
4689 'cls'
4690 }}->___create_node_ref ({
4691
4692 'id'
4693 => $attrs->{$nsuri}->{$ln},
4694
4695 'b'
4696 => ($self->{'b'}),
4697 }, {
4698 });
4699 ($self->{'b'})->{${$attrs->{$nsuri}->{$ln}}}->{
4700 'rc'
4701 }++;
4702
4703
4704 }
4705
4706 ;
4707 }
4708
4709 if (defined $newAttr->
4710 owner_element
4711 ) {
4712 if (defined $current and $current eq $newAttr) {
4713
4714 report Message::DOM::DOMCore::ManakaiDOMError -object => $self, '-type' => 'http://suika.fam.cx/~wakaba/archive/2004/dom/tree#replace-by-itself', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'set_attribute_node', 'rdata' => $newAttr, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Element::ManakaiDOMElement';
4715
4716 ;
4717 ## No return value
4718 } else {
4719
4720 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'INUSE_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'set_attribute_node', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Element::ManakaiDOMElement', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => 'newAttr', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#node' => $newAttr;
4721
4722 ;
4723 }
4724 } else { # not in use
4725 if ($strict and $self->
4726 manakai_read_only
4727 ) {
4728
4729 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'set_attribute_node', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#NOMOD_THIS', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Element::ManakaiDOMElement';
4730
4731 ;
4732 }
4733
4734 $attrs->{$nsuri}->{$ln} =
4735 $newAttr->{'id'}
4736 ;
4737
4738
4739 {
4740
4741
4742 $newAttr->{
4743 'b'
4744 }->{${$newAttr->{
4745 'id'
4746 }}}
4747 ->{'owner'} = $self->{
4748 'id'
4749 };
4750
4751
4752 }
4753
4754 ;
4755 $newAttr->
4756 specified
4757 (
4758 1
4759 );
4760
4761 if (defined $current) {
4762
4763
4764 {
4765
4766 CORE::delete
4767 $current->{
4768 'b'
4769 }->{${$current->{
4770 'id'
4771 }}}
4772 ->{'owner'};
4773
4774
4775 }
4776
4777 ;
4778 $r = $current;
4779 }
4780 }
4781
4782
4783 }
4784 $r}
4785 sub remove_attribute ($$) {
4786 my ($self, $name) = @_;
4787
4788 {
4789
4790 my
4791 $list;
4792 my $key;
4793 my $attr;
4794
4795
4796 {
4797
4798 my
4799 $__attr;
4800
4801
4802 {
4803
4804
4805 $__attr = $self->{
4806 'b'
4807 }->{${$self->{
4808 'id'
4809 }}}
4810 ->{'attr'};
4811
4812
4813 }
4814
4815 ;
4816
4817 ## Note that we no longer support DOM Level 1 nodes.
4818
4819 ## If an attribute's qualified name is equal to
4820 ## the requested name, then the node is the answer.
4821
4822 ## Note that if there is a namespace ill-formed attribute,
4823 ## the result is not the expected one. For example,
4824 ## if an |xmlns| attribute in the |http://www.w3.org/2000/xmlns/|
4825 ## namespace has non-NULL |prefix|, a request to get |xmlns|
4826 ## attribute will not return that node.
4827
4828 ## |sort|ing is required so that every |getAttribute|, |setAttribute|,
4829 ## |hasAttribute|, |removeAttribute|, or any other namespace unaware
4830 ## methods operates on the same node even if there is
4831 ## multiple nodes with the same qualified name.
4832
4833 NS: for my $__ns (sort {$a cmp $b} keys %$__attr) {
4834 for my $__ln (sort {$a cmp $b} keys %{$__attr->{$__ns}}) {
4835 my $__node;
4836
4837
4838 {
4839
4840
4841 $__node = ${($self->{'b'})->{${$__attr->{$__ns}->{$__ln}}}->{
4842 'cls'
4843 }}->___create_node_ref ({
4844
4845 'id'
4846 => $__attr->{$__ns}->{$__ln},
4847
4848 'b'
4849 => ($self->{'b'}),
4850 }, {
4851 });
4852 ($self->{'b'})->{${$__attr->{$__ns}->{$__ln}}}->{
4853 'rc'
4854 }++;
4855
4856
4857 }
4858
4859 ;
4860 if ($__node->
4861 node_name eq
4862 $name) {
4863
4864
4865 ;
4866
4867
4868 {
4869
4870
4871 $attr = $__node;
4872 $list = $__attr->{$__ns};
4873 $key = $__ln;
4874
4875
4876
4877 }
4878
4879 ;
4880 last NS;
4881 }
4882 } # ln
4883 } # NS
4884
4885
4886 }
4887
4888 ;
4889 if (defined $attr) {
4890 if ($self->
4891 manakai_read_only
4892 ) {
4893
4894 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'remove_attribute', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#NOMOD_THIS', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Element::ManakaiDOMElement';
4895
4896 ;
4897 }
4898
4899 ## Remove the attribute node
4900 CORE::delete $list->{$key};
4901
4902
4903 {
4904
4905 CORE::delete
4906 $attr->{
4907 'b'
4908 }->{${$attr->{
4909 'id'
4910 }}}
4911 ->{'owner'};
4912
4913
4914 }
4915
4916 ;
4917
4918 ## Default attribute
4919 my $doc = $self->
4920 owner_document
4921 ;
4922 my $doc_cfg = $doc->
4923 dom_config
4924 ;
4925 if ($doc_cfg->
4926 get_parameter
4927
4928 (
4929 'http://suika.fam.cx/www/2006/dom-config/dtd-default-attribute'
4930 )) {
4931 my $prefix;
4932
4933
4934 {
4935
4936
4937 {
4938
4939 local $Error::Depth = $Error::Depth + 1;
4940
4941 {
4942
4943
4944 my
4945 $__doctype = $doc->
4946 doctype
4947 ;
4948 $__doctype = $__doctype->
4949 get_feature
4950 (
4951 'http://suika.fam.cx/www/2006/feature/XDoctype'
4952 )
4953 if $__doctype;
4954 if (defined $__doctype) {
4955 my $__et = $__doctype->
4956 get_element_type_definition_node
4957
4958 ($self->node_name);
4959 if (defined $__et) {
4960 my $__orig_strict = $doc->
4961 strict_error_checking
4962 ;
4963 $doc->
4964 strict_error_checking
4965 (
4966 0
4967 );
4968
4969 my $__at = $__et->
4970 get_attribute_definition_node
4971 ($name);
4972 if (defined $__at) {
4973 my $__copy_asis = $doc_cfg->
4974 get_parameter
4975
4976 (
4977 'http://suika.fam.cx/www/2006/dom-config/clone-entity-reference-subtree'
4978 );
4979 $doc_cfg->
4980 set_parameter
4981
4982 (
4983 'http://suika.fam.cx/www/2006/dom-config/clone-entity-reference-subtree'
4984 =>
4985 1
4986 );
4987 ADD: {
4988 my $__attr;
4989 my $__attrs;
4990
4991
4992 {
4993
4994
4995 $__attrs = $self->{
4996 'b'
4997 }->{${$self->{
4998 'id'
4999 }}}
5000 ->{'attr'};
5001
5002
5003 }
5004
5005 ;
5006 if (defined $prefix) { ## prefixed attr
5007 my $__nsuri = $self->
5008 lookup_namespace_uri
5009
5010 ($prefix);
5011 unless (defined $__nsuri) {
5012 ## TODO: Namespace well-formedness error
5013 }
5014 if (defined $__attrs->{defined $__nsuri ? $__nsuri : ''}
5015 ->{$name}) {
5016 ## TODO: Namespace well-formedness warning?
5017 last ADD;
5018 }
5019 $__attr = $doc->
5020 create_attribute_ns
5021
5022 ($__nsuri, [$prefix, $name]);
5023 } else { ## local attr
5024 if ($name eq 'xmlns') {
5025 if (defined $__attrs->{
5026 'http://www.w3.org/2000/xmlns/'
5027 }->{xmlns}) {
5028 ## TODO: Namespace well-formedness warning?
5029 last ADD;
5030 }
5031 $__attr = $doc->
5032 create_attribute_ns
5033
5034 (
5035 'http://www.w3.org/2000/xmlns/'
5036 , 'xmlns');
5037 } else {
5038 if (defined $__attrs->{''}->{$name}) {
5039 ## TODO: Namespace well-formedness warning?
5040 last ADD;
5041 }
5042 $__attr = $doc->
5043 create_attribute
5044 ($name);
5045 }
5046 }
5047 for my $__at_child (@{$__at->
5048 child_nodes
5049 }) {
5050 $__attr->
5051 append_child
5052
5053 ($__at_child->
5054 clone_node
5055 (
5056 1
5057 ));
5058 }
5059 $__attr->
5060 manakai_attribute_type
5061
5062 ($__at->
5063 declared_type
5064 );
5065 $self->
5066 set_attribute_node_ns
5067 ($__attr);
5068 ## This method change the |specified| flag
5069 $__attr->
5070 specified
5071 (
5072 0
5073 );
5074 } # ADD
5075 $doc_cfg->
5076 set_parameter
5077
5078 (
5079 'http://suika.fam.cx/www/2006/dom-config/clone-entity-reference-subtree'
5080 => $__copy_asis);
5081 }
5082 $doc->
5083 strict_error_checking
5084 ($__orig_strict);
5085 } # et
5086 } # doctype
5087
5088
5089
5090 }
5091
5092
5093 ;}
5094
5095 ;
5096
5097
5098 }
5099
5100 ;
5101 }
5102 } # exists
5103
5104
5105 }
5106 }
5107 sub remove_attribute_ns ($$$) {
5108 my ($self, $namespaceURI, $localName) = @_;
5109
5110 {
5111
5112 if
5113 (CORE::defined $namespaceURI and CORE::length $namespaceURI == 0) {
5114 require Message::DOM::DOMMain;
5115
5116 report Message::DOM::DOMCore::ManakaiDOMError -object => $self, '-type' => 'http://suika.fam.cx/~wakaba/archive/2004/dom/main#empty-namespace-uri', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:tag:suika.fam.cx,2005-09:1165118814:1861:wAUT122229+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest';
5117
5118 ;
5119
5120
5121
5122 {
5123
5124
5125 $namespaceURI = undef;
5126
5127
5128
5129 }
5130
5131 ;
5132 }
5133
5134
5135 }
5136
5137 {
5138
5139 my
5140 $list;
5141 my $attr;
5142
5143
5144 {
5145
5146 my
5147 $__attrs;
5148
5149
5150 {
5151
5152
5153 $__attrs = $self->{
5154 'b'
5155 }->{${$self->{
5156 'id'
5157 }}}
5158 ->{'attr'};
5159
5160
5161 }
5162
5163 ;
5164 $list = $__attrs->{defined $namespaceURI ? $namespaceURI : ''};
5165 if (defined $list and defined $list->{$localName}) {
5166
5167
5168 {
5169
5170
5171 $attr = ${($self->{'b'})->{${$__attrs->{defined $namespaceURI ? $namespaceURI : ''}
5172 ->{$localName}}}->{
5173 'cls'
5174 }}->___create_node_ref ({
5175
5176 'id'
5177 => $__attrs->{defined $namespaceURI ? $namespaceURI : ''}
5178 ->{$localName},
5179
5180 'b'
5181 => ($self->{'b'}),
5182 }, {
5183 });
5184 ($self->{'b'})->{${$__attrs->{defined $namespaceURI ? $namespaceURI : ''}
5185 ->{$localName}}}->{
5186 'rc'
5187 }++;
5188
5189
5190 }
5191
5192 ;
5193 }
5194
5195
5196 }
5197
5198 ;
5199 if (defined $attr) {
5200 if ($self->
5201 manakai_read_only
5202 ) {
5203
5204 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'remove_attribute_ns', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#NOMOD_THIS', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Element::ManakaiDOMElement';
5205
5206 ;
5207 }
5208
5209 ## Removes the attribute node
5210 CORE::delete $list->{$localName};
5211
5212
5213 {
5214
5215 CORE::delete
5216 $attr->{
5217 'b'
5218 }->{${$attr->{
5219 'id'
5220 }}}
5221 ->{'owner'};
5222
5223
5224 }
5225
5226 ;
5227
5228 ## Default attribute
5229 my $doc = $self->
5230 owner_document
5231 ;
5232 my $doc_cfg = $doc->
5233 dom_config
5234 ;
5235 if ($doc_cfg->
5236 get_parameter
5237
5238 (
5239 'http://suika.fam.cx/www/2006/dom-config/dtd-default-attribute'
5240 )) {
5241 my $pfx = $attr->
5242 prefix
5243 ;
5244 my $name = defined $pfx ? $pfx.':'.$localName : $localName;
5245
5246
5247 {
5248
5249
5250 {
5251
5252 local $Error::Depth = $Error::Depth + 1;
5253
5254 {
5255
5256
5257 my
5258 $__doctype = $doc->
5259 doctype
5260 ;
5261 $__doctype = $__doctype->
5262 get_feature
5263 (
5264 'http://suika.fam.cx/www/2006/feature/XDoctype'
5265 )
5266 if $__doctype;
5267 if (defined $__doctype) {
5268 my $__et = $__doctype->
5269 get_element_type_definition_node
5270
5271 ($self->node_name);
5272 if (defined $__et) {
5273 my $__orig_strict = $doc->
5274 strict_error_checking
5275 ;
5276 $doc->
5277 strict_error_checking
5278 (
5279 0
5280 );
5281
5282 my $__at = $__et->
5283 get_attribute_definition_node
5284 ($name);
5285 if (defined $__at) {
5286 my $__copy_asis = $doc_cfg->
5287 get_parameter
5288
5289 (
5290 'http://suika.fam.cx/www/2006/dom-config/clone-entity-reference-subtree'
5291 );
5292 $doc_cfg->
5293 set_parameter
5294
5295 (
5296 'http://suika.fam.cx/www/2006/dom-config/clone-entity-reference-subtree'
5297 =>
5298 1
5299 );
5300 ADD: {
5301 my $__attr;
5302 my $__attrs;
5303
5304
5305 {
5306
5307
5308 $__attrs = $self->{
5309 'b'
5310 }->{${$self->{
5311 'id'
5312 }}}
5313 ->{'attr'};
5314
5315
5316 }
5317
5318 ;
5319 if (defined $pfx) { ## prefixed attr
5320 my $__nsuri = $self->
5321 lookup_namespace_uri
5322
5323 ($pfx);
5324 unless (defined $__nsuri) {
5325 ## TODO: Namespace well-formedness error
5326 }
5327 if (defined $__attrs->{defined $__nsuri ? $__nsuri : ''}
5328 ->{$localName}) {
5329 ## TODO: Namespace well-formedness warning?
5330 last ADD;
5331 }
5332 $__attr = $doc->
5333 create_attribute_ns
5334
5335 ($__nsuri, [$pfx, $localName]);
5336 } else { ## local attr
5337 if ($name eq 'xmlns') {
5338 if (defined $__attrs->{
5339 'http://www.w3.org/2000/xmlns/'
5340 }->{xmlns}) {
5341 ## TODO: Namespace well-formedness warning?
5342 last ADD;
5343 }
5344 $__attr = $doc->
5345 create_attribute_ns
5346
5347 (
5348 'http://www.w3.org/2000/xmlns/'
5349 , 'xmlns');
5350 } else {
5351 if (defined $__attrs->{''}->{$name}) {
5352 ## TODO: Namespace well-formedness warning?
5353 last ADD;
5354 }
5355 $__attr = $doc->
5356 create_attribute
5357 ($name);
5358 }
5359 }
5360 for my $__at_child (@{$__at->
5361 child_nodes
5362 }) {
5363 $__attr->
5364 append_child
5365
5366 ($__at_child->
5367 clone_node
5368 (
5369 1
5370 ));
5371 }
5372 $__attr->
5373 manakai_attribute_type
5374
5375 ($__at->
5376 declared_type
5377 );
5378 $self->
5379 set_attribute_node_ns
5380 ($__attr);
5381 ## This method change the |specified| flag
5382 $__attr->
5383 specified
5384 (
5385 0
5386 );
5387 } # ADD
5388 $doc_cfg->
5389 set_parameter
5390
5391 (
5392 'http://suika.fam.cx/www/2006/dom-config/clone-entity-reference-subtree'
5393 => $__copy_asis);
5394 }
5395 $doc->
5396 strict_error_checking
5397 ($__orig_strict);
5398 } # et
5399 } # doctype
5400
5401
5402
5403 }
5404
5405
5406 ;}
5407
5408 ;
5409
5410
5411 }
5412
5413 ;
5414 }
5415 } # exists
5416
5417
5418 }
5419 }
5420 sub remove_attribute_node ($$) {
5421 my ($self, $oldAttr) = @_;
5422 my $r;
5423
5424 {
5425
5426 my
5427 $od = $self->
5428 owner_document
5429 ;
5430 if ($od->
5431 strict_error_checking and
5432
5433 $self->
5434 manakai_read_only
5435 ) {
5436
5437 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'remove_attribute_node', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#NOMOD_THIS', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Element::ManakaiDOMElement';
5438
5439 ;
5440 }
5441
5442 my $ln = $oldAttr->
5443 local_name
5444 ;
5445 FIND: {
5446 my $attrs;
5447
5448
5449 {
5450
5451
5452 $attrs = $self->{
5453 'b'
5454 }->{${$self->{
5455 'id'
5456 }}}
5457 ->{'attr'};
5458
5459
5460 }
5461
5462 ;
5463 my $nsuri = $oldAttr->
5464 namespace_uri
5465 ;
5466 my $list = $attrs->{defined $nsuri ? $nsuri : ''};
5467 my $list_nid = $list->{$ln};
5468 if (defined $list_nid and
5469
5470 (${$oldAttr->{'id'}} eq ${$list_nid})
5471 ) {
5472 CORE::delete $list->{$ln};
5473 last FIND;
5474 }
5475
5476 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NOT_FOUND_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'remove_attribute_node', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#NOT_ATTR_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Element::ManakaiDOMElement', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => 'oldAttr', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#node' => $oldAttr;
5477
5478 ;
5479 } # FIND
5480
5481
5482
5483 {
5484
5485 CORE::delete
5486 $oldAttr->{
5487 'b'
5488 }->{${$oldAttr->{
5489 'id'
5490 }}}
5491 ->{'owner'};
5492
5493
5494 }
5495
5496 ;
5497 $r = $oldAttr;
5498
5499 ## Default attribute
5500 my $doc_cfg = $od->
5501 dom_config
5502 ;
5503 if ($doc_cfg->
5504 get_parameter
5505
5506 (
5507 'http://suika.fam.cx/www/2006/dom-config/dtd-default-attribute'
5508 )) {
5509 my $name = $oldAttr->
5510 node_name
5511 ;
5512 my $pfx = $oldAttr->
5513 prefix
5514 ;
5515
5516
5517 {
5518
5519
5520 {
5521
5522 local $Error::Depth = $Error::Depth + 1;
5523
5524 {
5525
5526
5527 my
5528 $__doctype = $od->
5529 doctype
5530 ;
5531 $__doctype = $__doctype->
5532 get_feature
5533 (
5534 'http://suika.fam.cx/www/2006/feature/XDoctype'
5535 )
5536 if $__doctype;
5537 if (defined $__doctype) {
5538 my $__et = $__doctype->
5539 get_element_type_definition_node
5540
5541 ($self->node_name);
5542 if (defined $__et) {
5543 my $__orig_strict = $od->
5544 strict_error_checking
5545 ;
5546 $od->
5547 strict_error_checking
5548 (
5549 0
5550 );
5551
5552 my $__at = $__et->
5553 get_attribute_definition_node
5554 ($name);
5555 if (defined $__at) {
5556 my $__copy_asis = $doc_cfg->
5557 get_parameter
5558
5559 (
5560 'http://suika.fam.cx/www/2006/dom-config/clone-entity-reference-subtree'
5561 );
5562 $doc_cfg->
5563 set_parameter
5564
5565 (
5566 'http://suika.fam.cx/www/2006/dom-config/clone-entity-reference-subtree'
5567 =>
5568 1
5569 );
5570 ADD: {
5571 my $__attr;
5572 my $__attrs;
5573
5574
5575 {
5576
5577
5578 $__attrs = $self->{
5579 'b'
5580 }->{${$self->{
5581 'id'
5582 }}}
5583 ->{'attr'};
5584
5585
5586 }
5587
5588 ;
5589 if (defined $pfx) { ## prefixed attr
5590 my $__nsuri = $self->
5591 lookup_namespace_uri
5592
5593 ($pfx);
5594 unless (defined $__nsuri) {
5595 ## TODO: Namespace well-formedness error
5596 }
5597 if (defined $__attrs->{defined $__nsuri ? $__nsuri : ''}
5598 ->{$ln}) {
5599 ## TODO: Namespace well-formedness warning?
5600 last ADD;
5601 }
5602 $__attr = $od->
5603 create_attribute_ns
5604
5605 ($__nsuri, [$pfx, $ln]);
5606 } else { ## local attr
5607 if ($name eq 'xmlns') {
5608 if (defined $__attrs->{
5609 'http://www.w3.org/2000/xmlns/'
5610 }->{xmlns}) {
5611 ## TODO: Namespace well-formedness warning?
5612 last ADD;
5613 }
5614 $__attr = $od->
5615 create_attribute_ns
5616
5617 (
5618 'http://www.w3.org/2000/xmlns/'
5619 , 'xmlns');
5620 } else {
5621 if (defined $__attrs->{''}->{$name}) {
5622 ## TODO: Namespace well-formedness warning?
5623 last ADD;
5624 }
5625 $__attr = $od->
5626 create_attribute
5627 ($name);
5628 }
5629 }
5630 for my $__at_child (@{$__at->
5631 child_nodes
5632 }) {
5633 $__attr->
5634 append_child
5635
5636 ($__at_child->
5637 clone_node
5638 (
5639 1
5640 ));
5641 }
5642 $__attr->
5643 manakai_attribute_type
5644
5645 ($__at->
5646 declared_type
5647 );
5648 $self->
5649 set_attribute_node_ns
5650 ($__attr);
5651 ## This method change the |specified| flag
5652 $__attr->
5653 specified
5654 (
5655 0
5656 );
5657 } # ADD
5658 $doc_cfg->
5659 set_parameter
5660
5661 (
5662 'http://suika.fam.cx/www/2006/dom-config/clone-entity-reference-subtree'
5663 => $__copy_asis);
5664 }
5665 $od->
5666 strict_error_checking
5667 ($__orig_strict);
5668 } # et
5669 } # doctype
5670
5671
5672
5673 }
5674
5675
5676 ;}
5677
5678 ;
5679
5680
5681 }
5682
5683 ;
5684 }
5685
5686
5687 }
5688 $r}
5689 sub schema_type_info ($;$) {
5690 if (@_ == 1) {my ($self) = @_;
5691 my $r;
5692
5693 {
5694
5695
5696 {
5697
5698 my
5699 $v = 0 || 0;
5700 $r = bless \$v,
5701 'Message::DOM::Element::ManakaiDOMDTDTypeInfo'
5702 ;
5703
5704
5705 }
5706
5707 ;
5708
5709
5710 }
5711 $r;
5712 } else {my ($self) = @_;
5713 report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Element::ManakaiDOMElement', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'schema_type_info';
5714 }
5715 }
5716 sub get_elements_by_tag_name ($$) {
5717 my ($self, $name) = @_;
5718 my $r;
5719
5720 {
5721
5722
5723 $name = "$name";
5724 my $chk;
5725 if ($name eq '*') {
5726 $chk = sub {
5727 1
5728 };
5729 } else {
5730 $chk = sub {
5731 my $node = shift;
5732 my $nodeName = $node->
5733 node_name
5734 ;
5735 ($nodeName eq $name);
5736 };
5737 }
5738
5739
5740 {
5741
5742
5743 $r = bless \[$self, $chk],
5744 'Message::DOM::TreeCore::ManakaiDOMGetElementsNodeList'
5745 ;
5746
5747
5748 }
5749
5750 ;
5751
5752
5753 }
5754 $r}
5755 sub get_elements_by_tag_name_ns ($$$) {
5756 my ($self, $namespaceURI, $localName) = @_;
5757
5758 {
5759
5760 if
5761 (CORE::defined $namespaceURI and CORE::length $namespaceURI == 0) {
5762 require Message::DOM::DOMMain;
5763
5764 report Message::DOM::DOMCore::ManakaiDOMError -object => $self, '-type' => 'http://suika.fam.cx/~wakaba/archive/2004/dom/main#empty-namespace-uri', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:tag:suika.fam.cx,2005-09:1165118814:1861:wAUT122229+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest';
5765
5766 ;
5767
5768
5769
5770 {
5771
5772
5773 $namespaceURI = undef;
5774
5775
5776
5777 }
5778
5779 ;
5780 }
5781
5782
5783 }
5784 my $r;
5785
5786 {
5787
5788
5789 $namespaceURI = "$namespaceURI" if defined $namespaceURI;
5790 $localName = "$localName";
5791 my $chk;
5792 if (not defined $namespaceURI) {
5793 if ($localName eq '*') {
5794 $chk = sub {
5795 my $node = shift;
5796 (not defined $node->
5797 namespace_uri
5798 );
5799 };
5800 } else {
5801 $chk = sub {
5802 my $node = shift;
5803 (not defined $node->
5804 namespace_uri and
5805
5806 $node->
5807 local_name eq
5808 $localName);
5809 };
5810 }
5811 } elsif ($namespaceURI eq '*') {
5812 if ($localName eq '*') {
5813 $chk = sub {
5814 1
5815 };
5816 } else {
5817 $chk = sub {
5818 my $node = shift;
5819 ($node->
5820 local_name eq
5821 $localName);
5822 };
5823 }
5824 } else {
5825 if ($localName eq '*') {
5826 $chk = sub {
5827 my $node = shift;
5828 my $nsuri = $node->
5829 namespace_uri
5830 ;
5831 (defined $nsuri and $nsuri eq $namespaceURI);
5832 };
5833 } else {
5834 $chk = sub {
5835 my $node = shift;
5836 my $nsuri = $node->
5837 namespace_uri
5838 ;
5839 (defined $nsuri and $nsuri eq $namespaceURI and
5840 $node->
5841 local_name eq
5842 $localName);
5843 };
5844 }
5845 }
5846
5847
5848 {
5849
5850
5851 $r = bless \[$self, $chk],
5852 'Message::DOM::TreeCore::ManakaiDOMGetElementsNodeList'
5853 ;
5854
5855
5856 }
5857
5858 ;
5859
5860
5861 }
5862 $r}
5863 sub manakai_base_uri ($;$) {
5864 if (@_ == 1) {my ($self) = @_;
5865 my $r = '';
5866
5867 {
5868
5869
5870 {
5871
5872
5873 $r = $self->{
5874 'b'
5875 }->{${$self->{
5876 'id'
5877 }}}
5878 ->{'buri'};
5879
5880
5881 }
5882
5883 ;
5884
5885
5886 }
5887 $r;
5888 } else {my ($self, $given) = @_;
5889
5890 {
5891
5892
5893 {
5894
5895 if
5896 ($self->
5897 manakai_read_only
5898 ) {
5899
5900 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#NOMOD_THIS', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/NodeReadOnlyError+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest';
5901
5902 ;
5903 }
5904
5905
5906 }
5907
5908 ;
5909
5910
5911 {
5912
5913
5914 $self->{
5915 'b'
5916 }->{${$self->{
5917 'id'
5918 }}}
5919 ->{'buri'} = $given;
5920
5921
5922 }
5923
5924 ;
5925
5926
5927 }
5928 }
5929 }
5930 sub set_id_attribute ($$;$) {
5931 my ($self, $name, $isId) = @_;
5932
5933 {
5934
5935
5936 {
5937
5938 if
5939 ($self->
5940 manakai_read_only
5941 ) {
5942
5943 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#NOMOD_THIS', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/NodeReadOnlyError+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest';
5944
5945 ;
5946 }
5947
5948
5949 }
5950
5951 ;
5952 my $attr = $self->
5953 get_attribute_node
5954 ($name);
5955 if (not defined $attr) {
5956
5957 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NOT_FOUND_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'set_id_attribute', 'http://www.w3.org/2001/04/infoset#namespaceName' => undef, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#NO_NAMED_NODE_NS_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Element::ManakaiDOMElement', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => 'name', 'http://www.w3.org/2001/04/infoset#localName' => $name;
5958
5959 ;
5960 } elsif ($attr->
5961 manakai_read_only
5962 ) {
5963
5964 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'set_id_attribute', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#NOMOD_ATTR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Element::ManakaiDOMElement', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => 'name', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#node' => $attr;
5965
5966 ;
5967 } else {
5968 $attr->
5969 is_id
5970 ($isId);
5971 }
5972
5973
5974 }
5975 }
5976 sub set_id_attribute_ns ($$$;$) {
5977 my ($self, $namespaceURI, $localName, $isId) = @_;
5978
5979 {
5980
5981 if
5982 (CORE::defined $namespaceURI and CORE::length $namespaceURI == 0) {
5983 require Message::DOM::DOMMain;
5984
5985 report Message::DOM::DOMCore::ManakaiDOMError -object => $self, '-type' => 'http://suika.fam.cx/~wakaba/archive/2004/dom/main#empty-namespace-uri', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:tag:suika.fam.cx,2005-09:1165118814:1861:wAUT122229+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest';
5986
5987 ;
5988
5989
5990
5991 {
5992
5993
5994 $namespaceURI = undef;
5995
5996
5997
5998 }
5999
6000 ;
6001 }
6002
6003
6004 }
6005
6006 {
6007
6008
6009 {
6010
6011 if
6012 ($self->
6013 manakai_read_only
6014 ) {
6015
6016 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#NOMOD_THIS', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/NodeReadOnlyError+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest';
6017
6018 ;
6019 }
6020
6021
6022 }
6023
6024 ;
6025 my $attr = $self->
6026 get_attribute_node_ns
6027
6028 ($namespaceURI, $localName);
6029 if (not defined $attr) {
6030
6031 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NOT_FOUND_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'set_id_attribute_ns', 'http://www.w3.org/2001/04/infoset#namespaceName' => $namespaceURI, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#NO_NAMED_NODE_NS_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Element::ManakaiDOMElement', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => 'name', 'http://www.w3.org/2001/04/infoset#localName' => $localName;
6032
6033 ;
6034 } elsif ($attr->
6035 manakai_read_only
6036 ) {
6037
6038 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'set_id_attribute_ns', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#NOMOD_ATTR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Element::ManakaiDOMElement', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => 'name', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#node' => $attr;
6039
6040 ;
6041 } else {
6042 $attr->
6043 is_id
6044 ($isId);
6045 }
6046
6047
6048 }
6049 }
6050 sub set_id_attribute_node ($$;$) {
6051 my ($self, $idAttr, $isId) = @_;
6052
6053 {
6054
6055
6056 {
6057
6058 if
6059 ($self->
6060 manakai_read_only
6061 ) {
6062
6063 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#NOMOD_THIS', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/NodeReadOnlyError+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest';
6064
6065 ;
6066 }
6067
6068
6069 }
6070
6071 ;
6072
6073 my $owner = $idAttr->
6074 owner_element
6075 ;
6076 if (not defined $owner or not $owner eq $self) {
6077
6078 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NOT_FOUND_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'set_id_attribute_node', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#NOT_ATTR_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Element::ManakaiDOMElement', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => 'idAttr', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#node' => $idAttr;
6079
6080 ;
6081 } elsif ($idAttr->
6082 manakai_read_only
6083 ) {
6084
6085 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'set_id_attribute_node', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#NOMOD_ATTR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Element::ManakaiDOMElement', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => 'name', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#node' => $idAttr;
6086
6087 ;
6088 } else {
6089 $idAttr->
6090 is_id
6091 ($isId);
6092 }
6093
6094
6095 }
6096 }
6097 $Message::DOM::DOMFeature::ClassInfo->{q<Message::DOM::Element::ManakaiDOMElement>}->{has_feature} = {'core',
6098 {'',
6099 '1',
6100 '1.0',
6101 '1',
6102 '2.0',
6103 '1',
6104 '3.0',
6105 '1'},
6106 'xml',
6107 {'',
6108 '1',
6109 '1.0',
6110 '1',
6111 '2.0',
6112 '1',
6113 '3.0',
6114 '1'},
6115 'xmlversion',
6116 {'',
6117 '1',
6118 '1.0',
6119 '1',
6120 '1.1',
6121 '1'}};
6122 $Message::DOM::ClassPoint{q<Message::DOM::Element::ManakaiDOMElement>} = 14.1;
6123 $Message::DOM::DOMFeature::ClassInfo->{q<Message::DOM::Element::ManakaiDOMElement>}->{compat_class}->{q<Message::DOM::Element::ManakaiDOMElement>} = 1;
6124 $Message::Util::Grove::ClassProp{q<Message::DOM::Element::ManakaiDOMElement>} = {'o0',
6125 ['parent'],
6126 's1a',
6127 ['child'],
6128 's2hh',
6129 ['attr'],
6130 'w0',
6131 ['od']};
6132 package Message::DOM::IFLatest::Attr;
6133 our $VERSION = 20061203.0432;
6134 package Message::DOM::Element::ManakaiDOMAttr;
6135 our $VERSION = 20061203.0432;
6136 push our @ISA, 'Message::DOM::TreeCore::ManakaiDOMNode',
6137 'Message::DOM::IF::Attr',
6138 'Message::DOM::IF::Node',
6139 'Message::DOM::IFLatest::Attr',
6140 'Message::DOM::IFLatest::Node',
6141 'Message::DOM::IFLevel1::Attr',
6142 'Message::DOM::IFLevel1::Node',
6143 'Message::DOM::IFLevel2::Attr',
6144 'Message::DOM::IFLevel2::Node',
6145 'Message::DOM::IFLevel3::Attr',
6146 'Message::DOM::IFLevel3::Node';
6147 use Char::Class::XML 'InXMLNameChar10',
6148 'InXMLNameChar11',
6149 'InXMLNameStartChar11',
6150 'InXML_NameStartChar10';
6151 sub ___create_node_stem ($$$$) {
6152 my ($self, $bag, $obj, $opt) = @_;
6153 my $r = {};
6154
6155 {
6156
6157
6158 $obj->{
6159 'child'
6160 } = [];
6161
6162
6163 {
6164
6165 if
6166 (defined ${$opt->{'ns'}}) {
6167 if (ref ${$opt->{'ns'}} eq 'SCALAR') {
6168 $obj->{'ns'} = ${$opt->{'ns'}};
6169 } elsif (defined $Message::Util::ManakaiStringRef::Value{${$opt->{'ns'}}}) {
6170 $obj->{'ns'} = $Message::Util::ManakaiStringRef::Value{${$opt->{'ns'}}};
6171 } else {
6172 require Scalar::Util;
6173 $obj->{'ns'} = $Message::Util::ManakaiStringRef::Value{${$opt->{'ns'}}} = \(${$opt->{'ns'}});
6174 Scalar::Util::weaken ($Message::Util::ManakaiStringRef::Value{${$opt->{'ns'}}});
6175 }
6176 } else {
6177 CORE::delete $obj->{'ns'};
6178 }
6179
6180
6181 }
6182
6183 ;
6184
6185
6186 {
6187
6188 if
6189 (defined ${$opt->{'pfx'}}) {
6190 if (ref ${$opt->{'pfx'}} eq 'SCALAR') {
6191 $obj->{'pfx'} = ${$opt->{'pfx'}};
6192 } elsif (defined $Message::Util::ManakaiStringRef::Value{${$opt->{'pfx'}}}) {
6193 $obj->{'pfx'} = $Message::Util::ManakaiStringRef::Value{${$opt->{'pfx'}}};
6194 } else {
6195 require Scalar::Util;
6196 $obj->{'pfx'} = $Message::Util::ManakaiStringRef::Value{${$opt->{'pfx'}}} = \(${$opt->{'pfx'}});
6197 Scalar::Util::weaken ($Message::Util::ManakaiStringRef::Value{${$opt->{'pfx'}}});
6198 }
6199 } else {
6200 CORE::delete $obj->{'pfx'};
6201 }
6202
6203
6204 }
6205
6206 ;
6207
6208
6209 {
6210
6211 if
6212 (defined ${$opt->{'ln'}}) {
6213 if (ref ${$opt->{'ln'}} eq 'SCALAR') {
6214 $obj->{'ln'} = ${$opt->{'ln'}};
6215 } elsif (defined $Message::Util::ManakaiStringRef::Value{${$opt->{'ln'}}}) {
6216 $obj->{'ln'} = $Message::Util::ManakaiStringRef::Value{${$opt->{'ln'}}};
6217 } else {
6218 require Scalar::Util;
6219 $obj->{'ln'} = $Message::Util::ManakaiStringRef::Value{${$opt->{'ln'}}} = \(${$opt->{'ln'}});
6220 Scalar::Util::weaken ($Message::Util::ManakaiStringRef::Value{${$opt->{'ln'}}});
6221 }
6222 } else {
6223 CORE::delete $obj->{'ln'};
6224 }
6225
6226
6227 }
6228
6229 ;
6230 $obj->{
6231 'specified'
6232 } = $opt->{
6233 'specified'
6234 };
6235
6236
6237 {
6238
6239
6240 $obj->{'od'} = $opt->{'od'}->{
6241 'id'
6242 };
6243 $bag->{${$opt->{'od'}->{
6244 'id'
6245 }}}
6246 ->{'do'}->{${$obj->{
6247 'id'
6248 }}}
6249 = $obj->{
6250 'id'
6251 };
6252
6253
6254 }
6255
6256 ;
6257 $r = $obj;
6258
6259
6260 }
6261 $r}
6262 sub node_type ($;$) {
6263 if (@_ == 1) {my ($self) = @_;
6264 my $r;
6265 $r = 2;
6266 $r;
6267 } else {my ($self) = @_;
6268 report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Element::ManakaiDOMAttr', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'node_type';
6269 }
6270 }
6271 sub prefix ($;$) {
6272 if (@_ == 1) {my ($self) = @_;
6273 my $r = '';
6274
6275 {
6276
6277 my
6278 $v;
6279
6280
6281 {
6282
6283
6284 $v = $self->{
6285 'b'
6286 }->{${$self->{
6287 'id'
6288 }}}
6289 ->{'pfx'};
6290
6291
6292 }
6293
6294 ;
6295 $r = defined $v ? $$v :
6296 undef
6297 ;
6298
6299
6300 }
6301 $r;
6302 } else {my ($self, $given) = @_;
6303
6304 {
6305
6306 my
6307 $od = $self->
6308 owner_document
6309 ;
6310 if ($od->
6311 strict_error_checking
6312 ) {
6313
6314
6315 {
6316
6317 if
6318 ($self->
6319 manakai_read_only
6320 ) {
6321
6322 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#NOMOD_THIS', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/NodeReadOnlyError+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest';
6323
6324 ;
6325 }
6326
6327
6328 }
6329
6330 ;
6331 my $nsuri;
6332
6333
6334 {
6335
6336
6337 $nsuri = $self->{
6338 'b'
6339 }->{${$self->{
6340 'id'
6341 }}}
6342 ->{'ns'};
6343
6344
6345 }
6346
6347 ;
6348 if (not defined $nsuri) {
6349
6350 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NAMESPACE_ERR', 'http://www.w3.org/2001/04/infoset#namespaceName' => undef, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'set', 'http://www.w3.org/2001/04/infoset#prefix' => $given, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#MDOM_NS_PREFIX_WITH_NULL_URI', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Element::ManakaiDOMAttr', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'prefix';
6351
6352 ;
6353 } elsif ($$nsuri ne
6354 'http://www.w3.org/XML/1998/namespace' and
6355
6356 defined $given and $given eq 'xml') {
6357
6358 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NAMESPACE_ERR', 'http://www.w3.org/2001/04/infoset#namespaceName' => $self->namespace_uri, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'set', 'http://www.w3.org/2001/04/infoset#prefix' => $given, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#MDOM_NS_XML_WITH_OTHER_URI', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Element::ManakaiDOMAttr', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'prefix';
6359
6360 ;
6361 } elsif ($$nsuri ne
6362 'http://www.w3.org/2000/xmlns/' and
6363
6364 defined $given and $given eq 'xmlns') {
6365
6366 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NAMESPACE_ERR', 'http://www.w3.org/2001/04/infoset#namespaceName' => $self->namespace_uri, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'set', 'http://www.w3.org/2001/04/infoset#prefix' => $given, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#MDOM_NS_XMLNS_WITH_OTHER_URI', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Element::ManakaiDOMAttr', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'prefix';
6367
6368 ;
6369 } elsif ($self->
6370 node_name eq
6371 'xmlns') {
6372
6373 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NAMESPACE_ERR', 'http://www.w3.org/2001/04/infoset#namespaceName' => $self->namespace_uri, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'set', 'http://www.w3.org/2001/04/infoset#prefix' => $given, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#MDOM_NS_QNAME_IS_XMLNS', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Element::ManakaiDOMAttr', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'prefix';
6374
6375 ;
6376 }
6377 my $version = $od->
6378 xml_version
6379 ;
6380
6381
6382 {
6383
6384 if
6385 (defined $given and $given eq '') {
6386 require Message::DOM::DOMMain;
6387
6388 report Message::DOM::DOMCore::ManakaiDOMError -object => $self, '-type' => 'http://suika.fam.cx/~wakaba/archive/2004/dom/main#empty-namespace-prefix', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2004/dom/main%23ensureNamespacePrefix+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest';
6389
6390 ;
6391 undef $given;
6392 }
6393 if (defined $given) {
6394 if (($version eq '1.0' and
6395 not
6396 ($given =~ /\A\p{InXML_NameStartChar10}\p{InXMLNameChar10}*\z/)
6397 ) or
6398 ($version eq '1.1' and
6399 not
6400 ($given =~ /\A\p{InXMLNameStartChar11}\p{InXMLNameChar11}*\z/)
6401 )) {
6402
6403 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'INVALID_CHARACTER_ERR', 'http://www.w3.org/2001/04/infoset#name' => $given, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#MDOM_BAD_NAME', 'http://www.w3.org/2001/04/infoset#version' => $version, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2004/dom/main%23ensureNamespacePrefix+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => '$INPUT_PARAM_NAME';
6404
6405 ;
6406 } elsif (index ($given, ':') > -1) {
6407
6408 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NAMESPACE_ERR', 'http://www.w3.org/2001/04/infoset#name' => $given, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#MDOM_NS_BAD_NCNAME', 'http://www.w3.org/2001/04/infoset#version' => $version, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2004/dom/main%23ensureNamespacePrefix+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => '$INPUT_PARAM_NAME';
6409
6410 ;
6411 }
6412 } # has prefix
6413
6414
6415 }
6416
6417 ;
6418 } # strict
6419 my $v = defined $given ? \$given :
6420 undef
6421 ;
6422
6423
6424 {
6425
6426
6427 $self->{
6428 'b'
6429 }->{${$self->{
6430 'id'
6431 }}}
6432 ->{'pfx'} = $v;
6433
6434
6435 }
6436
6437 ;
6438
6439
6440 }
6441 }
6442 }
6443 sub append_child ($$) {
6444 my ($self, $newChild) = @_;
6445 my $r;
6446
6447 {
6448
6449 my
6450 $self_od = $self->
6451 owner_document
6452 ;
6453 my $child_od = $newChild->
6454 owner_document
6455 ;
6456 my $child_nt = $newChild->
6457 node_type
6458 ;
6459
6460
6461 {
6462
6463
6464 {
6465
6466 local $Error::Depth = $Error::Depth + 1;
6467
6468 {
6469
6470
6471 my
6472 $strict = $self_od->
6473 strict_error_checking
6474 ;
6475
6476 ## -- Node Type check
6477 my @new_child;
6478 if ({
6479 3 => 1,
6480 5 => 1,
6481 }->{$child_nt}) {
6482 push @new_child, $newChild;
6483 } elsif ($child_nt ==
6484 11
6485 ) {
6486 for my $cn (@{$newChild->
6487 child_nodes
6488 }) {
6489 unless ({
6490 3 => 1,
6491 5 => 1,
6492 }->{$cn->
6493 node_type
6494 }) {
6495
6496
6497 {
6498
6499 local $Error::Depth = $Error::Depth - 1;
6500
6501 {
6502
6503 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'HIERARCHY_REQUEST_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#HIERARCHY_BAD_TYPE', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/appendChildImpl1+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => 'newChild', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#node' => $newChild;
6504
6505
6506 }
6507
6508
6509 ;}
6510
6511 ;
6512 }
6513 push @new_child, $cn;
6514 }
6515 } else {
6516
6517
6518 {
6519
6520 local $Error::Depth = $Error::Depth - 1;
6521
6522 {
6523
6524 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'HIERARCHY_REQUEST_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#HIERARCHY_BAD_TYPE', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/appendChildImpl1+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => 'newChild', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#node' => $newChild;
6525
6526
6527 }
6528
6529
6530 ;}
6531
6532 ;
6533 }
6534
6535 my $nc_parent = @new_child ? $new_child[0]->
6536 parent_node
6537 :
6538
6539 undef
6540 ;
6541 if ($strict) {
6542 ## -- Wrong-document check
6543 unless ($self_od eq $child_od) {
6544
6545
6546 {
6547
6548 local $Error::Depth = $Error::Depth - 1;
6549
6550 {
6551
6552 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'WRONG_DOCUMENT_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#DIFFERENT_DOCUMENT_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/appendChildImpl1+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => 'newChild', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#node' => $newChild;
6553
6554
6555 }
6556
6557
6558 ;}
6559
6560 ;
6561 }
6562
6563 ## -- Read-onlyness check
6564 if ($self->
6565 manakai_read_only
6566 ) {
6567
6568
6569 {
6570
6571 local $Error::Depth = $Error::Depth - 1;
6572
6573 {
6574
6575 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#NOMOD_THIS', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/appendChildImpl1+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest';
6576
6577
6578 }
6579
6580
6581 ;}
6582
6583 ;
6584 }
6585 if (@new_child) {
6586 if ($nc_parent and
6587 $nc_parent->
6588 manakai_read_only
6589 ) {
6590
6591
6592 {
6593
6594 local $Error::Depth = $Error::Depth - 1;
6595
6596 {
6597
6598 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#NOMOD_SRC_PARENT', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/appendChildImpl1+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest';
6599
6600
6601 }
6602
6603
6604 ;}
6605
6606 ;
6607 }
6608 }
6609 }
6610
6611 ## -- Insert at...
6612 my $index = -1; # last
6613
6614
6615 ; # FOR !tc:ForAppendChild
6616
6617 ## -- Removes from parent
6618 if ($nc_parent) {
6619 if ($child_nt ==
6620 11
6621 ) {
6622
6623
6624 {
6625
6626
6627 $newChild->{
6628 'b'
6629 }->{${$newChild->{
6630 'id'
6631 }}}
6632 ->{'child'} = [];
6633
6634
6635 }
6636
6637 ;
6638 } else {
6639 my $v;
6640
6641
6642 {
6643
6644
6645 $v = $nc_parent->{
6646 'b'
6647 }->{${$nc_parent->{
6648 'id'
6649 }}}
6650 ->{'child'};
6651
6652
6653 }
6654
6655 ;
6656 RP: for my $i (0..$#$v) {
6657 my $nodeid = $v->[$i];
6658 if (
6659 (${$new_child[0]->{'id'}} eq ${$nodeid})
6660 ) {
6661 splice @$v, $i, 1, ();
6662 last RP;
6663 }
6664 } # RP
6665 }
6666 }
6667
6668 ## -- Rewrite the |parentNode| properties
6669 for my $nc (@new_child) {
6670
6671
6672 {
6673
6674
6675 $nc->{
6676 'b'
6677 }->{${$nc->{
6678 'id'
6679 }}}
6680 ->{'parent'} = $self->{
6681 'id'
6682 };
6683
6684
6685 }
6686
6687 ;
6688 }
6689
6690 my $children;
6691
6692
6693 {
6694
6695
6696 $children = $self->{
6697 'b'
6698 }->{${$self->{
6699 'id'
6700 }}}
6701 ->{'child'};
6702
6703
6704 }
6705
6706 ;
6707
6708
6709
6710 {
6711
6712
6713 ## -- Adds to children list
6714 push @$children, map {
6715
6716 $_->{'id'}
6717
6718 } @new_child;
6719 $r = $newChild;
6720
6721
6722
6723 }
6724
6725 ;
6726
6727
6728
6729 ;
6730
6731
6732
6733 ;
6734
6735
6736
6737 }
6738
6739
6740 ;}
6741
6742 ;
6743
6744
6745 }
6746
6747 ;
6748
6749
6750 }
6751 $r}
6752 sub insert_before ($$;$) {
6753 my ($self, $newChild, $refChild) = @_;
6754 my $r;
6755
6756 {
6757
6758 my
6759 $self_od = $self->
6760 owner_document
6761 ;
6762 my $child_od = $newChild->
6763 owner_document
6764 ;
6765 my $child_nt = $newChild->
6766 node_type
6767 ;
6768
6769
6770 {
6771
6772
6773 {
6774
6775 local $Error::Depth = $Error::Depth + 1;
6776
6777 {
6778
6779
6780 my
6781 $strict = $self_od->
6782 strict_error_checking
6783 ;
6784
6785 ## -- Node Type check
6786 my @new_child;
6787 if ({
6788 3 => 1,
6789 5 => 1,
6790 }->{$child_nt}) {
6791 push @new_child, $newChild;
6792 } elsif ($child_nt ==
6793 11
6794 ) {
6795 for my $cn (@{$newChild->
6796 child_nodes
6797 }) {
6798 unless ({
6799 3 => 1,
6800 5 => 1,
6801 }->{$cn->
6802 node_type
6803 }) {
6804
6805
6806 {
6807
6808 local $Error::Depth = $Error::Depth - 1;
6809
6810 {
6811
6812 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'HIERARCHY_REQUEST_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#HIERARCHY_BAD_TYPE', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/insertBeforeImpl1+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => 'newChild', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#node' => $newChild;
6813
6814
6815 }
6816
6817
6818 ;}
6819
6820 ;
6821 }
6822 push @new_child, $cn;
6823 }
6824 } else {
6825
6826
6827 {
6828
6829 local $Error::Depth = $Error::Depth - 1;
6830
6831 {
6832
6833 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'HIERARCHY_REQUEST_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#HIERARCHY_BAD_TYPE', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/insertBeforeImpl1+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => 'newChild', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#node' => $newChild;
6834
6835
6836 }
6837
6838
6839 ;}
6840
6841 ;
6842 }
6843
6844 my $nc_parent = @new_child ? $new_child[0]->
6845 parent_node
6846 :
6847
6848 undef
6849 ;
6850 if ($strict) {
6851 ## -- Wrong-document check
6852 unless ($self_od eq $child_od) {
6853
6854
6855 {
6856
6857 local $Error::Depth = $Error::Depth - 1;
6858
6859 {
6860
6861 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'WRONG_DOCUMENT_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#DIFFERENT_DOCUMENT_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/insertBeforeImpl1+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => 'newChild', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#node' => $newChild;
6862
6863
6864 }
6865
6866
6867 ;}
6868
6869 ;
6870 }
6871
6872 ## -- Read-onlyness check
6873 if ($self->
6874 manakai_read_only
6875 ) {
6876
6877
6878 {
6879
6880 local $Error::Depth = $Error::Depth - 1;
6881
6882 {
6883
6884 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#NOMOD_THIS', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/insertBeforeImpl1+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest';
6885
6886
6887 }
6888
6889
6890 ;}
6891
6892 ;
6893 }
6894 if (@new_child) {
6895 if ($nc_parent and
6896 $nc_parent->
6897 manakai_read_only
6898 ) {
6899
6900
6901 {
6902
6903 local $Error::Depth = $Error::Depth - 1;
6904
6905 {
6906
6907 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#NOMOD_SRC_PARENT', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/insertBeforeImpl1+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest';
6908
6909
6910 }
6911
6912
6913 ;}
6914
6915 ;
6916 }
6917 }
6918 }
6919
6920 ## -- Insert at...
6921 my $index = -1; # last
6922
6923
6924 {
6925
6926
6927 # tc:ForAppendChild & tc:ForReplaceChild
6928 if (defined $refChild) {
6929 if ($refChild eq $newChild) {
6930
6931
6932 {
6933
6934
6935 {
6936
6937 local $Error::Depth = $Error::Depth - 1;
6938
6939 {
6940
6941 report Message::DOM::DOMCore::ManakaiDOMError -object => $self, '-type' => 'http://suika.fam.cx/~wakaba/archive/2004/dom/tree#insert-before-itself', 'rdata' => $refChild, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/insertBeforeImpl1+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest';
6942
6943
6944 }
6945
6946
6947 ;}
6948
6949 ;
6950
6951
6952
6953 }
6954
6955 ;
6956
6957
6958 ;
6959 }
6960
6961 my $cns = $self->
6962 child_nodes
6963 ;
6964 my $cnsl = @$cns;
6965 C: {
6966 $index = 0;
6967 for my $i (0..($cnsl-1)) {
6968 my $cn = $cns->[$i];
6969 if ($cn eq $refChild) {
6970 $index += $i;
6971 last C;
6972 } elsif ($cn eq $newChild) {
6973 $index = -1; # offset
6974 }
6975 }
6976
6977
6978 {
6979
6980
6981 {
6982
6983 local $Error::Depth = $Error::Depth - 1;
6984
6985 {
6986
6987 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NOT_FOUND_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#NOT_CHILD_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/insertBeforeImpl1+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => 'refChild', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#node' => $refChild;
6988
6989
6990 }
6991
6992
6993 ;}
6994
6995 ;
6996
6997
6998
6999 }
7000
7001 ;
7002
7003
7004 ;
7005 } # C
7006 } else { # |oldChild| is not defined
7007
7008
7009 ;
7010 }
7011
7012
7013
7014 }
7015
7016 ; # FOR !tc:ForAppendChild
7017
7018 ## -- Removes from parent
7019 if ($nc_parent) {
7020 if ($child_nt ==
7021 11
7022 ) {
7023
7024
7025 {
7026
7027
7028 $newChild->{
7029 'b'
7030 }->{${$newChild->{
7031 'id'
7032 }}}
7033 ->{'child'} = [];
7034
7035
7036 }
7037
7038 ;
7039 } else {
7040 my $v;
7041
7042
7043 {
7044
7045
7046 $v = $nc_parent->{
7047 'b'
7048 }->{${$nc_parent->{
7049 'id'
7050 }}}
7051 ->{'child'};
7052
7053
7054 }
7055
7056 ;
7057 RP: for my $i (0..$#$v) {
7058 my $nodeid = $v->[$i];
7059 if (
7060 (${$new_child[0]->{'id'}} eq ${$nodeid})
7061 ) {
7062 splice @$v, $i, 1, ();
7063 last RP;
7064 }
7065 } # RP
7066 }
7067 }
7068
7069 ## -- Rewrite the |parentNode| properties
7070 for my $nc (@new_child) {
7071
7072
7073 {
7074
7075
7076 $nc->{
7077 'b'
7078 }->{${$nc->{
7079 'id'
7080 }}}
7081 ->{'parent'} = $self->{
7082 'id'
7083 };
7084
7085
7086 }
7087
7088 ;
7089 }
7090
7091 my $children;
7092
7093
7094 {
7095
7096
7097 $children = $self->{
7098 'b'
7099 }->{${$self->{
7100 'id'
7101 }}}
7102 ->{'child'};
7103
7104
7105 }
7106
7107 ;
7108
7109
7110
7111 ;
7112
7113
7114
7115 {
7116
7117
7118 ## -- Adds to children list
7119 if ($index == -1) {
7120 push @$children, map {
7121
7122 $_->{'id'}
7123
7124 } @new_child;
7125 } else {
7126 splice @$children, $index, 0, map {
7127
7128 $_->{'id'}
7129
7130 } @new_child;
7131 }
7132 $r = $newChild;
7133
7134
7135
7136 }
7137
7138 ;
7139
7140
7141
7142 ;
7143
7144
7145
7146 }
7147
7148
7149 ;}
7150
7151 ;
7152
7153
7154 }
7155
7156 ;
7157
7158
7159 }
7160 $r}
7161 sub replace_child ($$$) {
7162 my ($self, $newChild, $oldChild) = @_;
7163 my $r;
7164
7165 {
7166
7167 my
7168 $self_od = $self->
7169 owner_document
7170 ;
7171 my $child_od = $newChild->
7172 owner_document
7173 ;
7174 my $child_nt = $newChild->
7175 node_type
7176 ;
7177
7178
7179 {
7180
7181
7182 {
7183
7184 local $Error::Depth = $Error::Depth + 1;
7185
7186 {
7187
7188
7189 my
7190 $strict = $self_od->
7191 strict_error_checking
7192 ;
7193
7194 ## -- Node Type check
7195 my @new_child;
7196 if ({
7197 3 => 1,
7198 5 => 1,
7199 }->{$child_nt}) {
7200 push @new_child, $newChild;
7201 } elsif ($child_nt ==
7202 11
7203 ) {
7204 for my $cn (@{$newChild->
7205 child_nodes
7206 }) {
7207 unless ({
7208 3 => 1,
7209 5 => 1,
7210 }->{$cn->
7211 node_type
7212 }) {
7213
7214
7215 {
7216
7217 local $Error::Depth = $Error::Depth - 1;
7218
7219 {
7220
7221 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'HIERARCHY_REQUEST_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#HIERARCHY_BAD_TYPE', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/replaceChildImpl1+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => 'newChild', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#node' => $newChild;
7222
7223
7224 }
7225
7226
7227 ;}
7228
7229 ;
7230 }
7231 push @new_child, $cn;
7232 }
7233 } else {
7234
7235
7236 {
7237
7238 local $Error::Depth = $Error::Depth - 1;
7239
7240 {
7241
7242 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'HIERARCHY_REQUEST_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#HIERARCHY_BAD_TYPE', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/replaceChildImpl1+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => 'newChild', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#node' => $newChild;
7243
7244
7245 }
7246
7247
7248 ;}
7249
7250 ;
7251 }
7252
7253 my $nc_parent = @new_child ? $new_child[0]->
7254 parent_node
7255 :
7256
7257 undef
7258 ;
7259 if ($strict) {
7260 ## -- Wrong-document check
7261 unless ($self_od eq $child_od) {
7262
7263
7264 {
7265
7266 local $Error::Depth = $Error::Depth - 1;
7267
7268 {
7269
7270 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'WRONG_DOCUMENT_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#DIFFERENT_DOCUMENT_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/replaceChildImpl1+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => 'newChild', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#node' => $newChild;
7271
7272
7273 }
7274
7275
7276 ;}
7277
7278 ;
7279 }
7280
7281 ## -- Read-onlyness check
7282 if ($self->
7283 manakai_read_only
7284 ) {
7285
7286
7287 {
7288
7289 local $Error::Depth = $Error::Depth - 1;
7290
7291 {
7292
7293 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#NOMOD_THIS', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/replaceChildImpl1+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest';
7294
7295
7296 }
7297
7298
7299 ;}
7300
7301 ;
7302 }
7303 if (@new_child) {
7304 if ($nc_parent and
7305 $nc_parent->
7306 manakai_read_only
7307 ) {
7308
7309
7310 {
7311
7312 local $Error::Depth = $Error::Depth - 1;
7313
7314 {
7315
7316 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#NOMOD_SRC_PARENT', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/replaceChildImpl1+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest';
7317
7318
7319 }
7320
7321
7322 ;}
7323
7324 ;
7325 }
7326 }
7327 }
7328
7329 ## -- Insert at...
7330 my $index = -1; # last
7331
7332
7333 {
7334
7335
7336 # tc:ForAppendChild & tc:ForReplaceChild
7337 if (defined $oldChild) {
7338 if ($oldChild eq $newChild) {
7339
7340
7341 ;
7342
7343
7344 {
7345
7346
7347 {
7348
7349 local $Error::Depth = $Error::Depth - 1;
7350
7351 {
7352
7353 report Message::DOM::DOMCore::ManakaiDOMError -object => $self, '-type' => 'http://suika.fam.cx/~wakaba/archive/2004/dom/tree#replace-by-itself', 'rdata' => $oldChild, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/replaceChildImpl1+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest';
7354
7355
7356 }
7357
7358
7359 ;}
7360
7361 ;
7362
7363
7364
7365 }
7366
7367 ;
7368 }
7369
7370 my $cns = $self->
7371 child_nodes
7372 ;
7373 my $cnsl = @$cns;
7374 C: {
7375 $index = 0;
7376 for my $i (0..($cnsl-1)) {
7377 my $cn = $cns->[$i];
7378 if ($cn eq $oldChild) {
7379 $index += $i;
7380 last C;
7381 } elsif ($cn eq $newChild) {
7382 $index = -1; # offset
7383 }
7384 }
7385
7386
7387 ;
7388
7389
7390 {
7391
7392
7393 {
7394
7395 local $Error::Depth = $Error::Depth - 1;
7396
7397 {
7398
7399 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NOT_FOUND_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#NOT_CHILD_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/replaceChildImpl1+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => 'oldChild', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#node' => $oldChild;
7400
7401
7402 }
7403
7404
7405 ;}
7406
7407 ;
7408
7409
7410
7411 }
7412
7413 ;
7414 } # C
7415 } else { # |oldChild| is not defined
7416
7417
7418 {
7419
7420
7421 {
7422
7423 local $Error::Depth = $Error::Depth - 1;
7424
7425 {
7426
7427 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NOT_FOUND_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#NOT_CHILD_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/replaceChildImpl1+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => 'oldChild', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#node' => $oldChild;
7428
7429
7430 }
7431
7432
7433 ;}
7434
7435 ;
7436
7437
7438
7439 }
7440
7441 ;
7442 }
7443
7444
7445
7446 }
7447
7448 ; # FOR !tc:ForAppendChild
7449
7450 ## -- Removes from parent
7451 if ($nc_parent) {
7452 if ($child_nt ==
7453 11
7454 ) {
7455
7456
7457 {
7458
7459
7460 $newChild->{
7461 'b'
7462 }->{${$newChild->{
7463 'id'
7464 }}}
7465 ->{'child'} = [];
7466
7467
7468 }
7469
7470 ;
7471 } else {
7472 my $v;
7473
7474
7475 {
7476
7477
7478 $v = $nc_parent->{
7479 'b'
7480 }->{${$nc_parent->{
7481 'id'
7482 }}}
7483 ->{'child'};
7484
7485
7486 }
7487
7488 ;
7489 RP: for my $i (0..$#$v) {
7490 my $nodeid = $v->[$i];
7491 if (
7492 (${$new_child[0]->{'id'}} eq ${$nodeid})
7493 ) {
7494 splice @$v, $i, 1, ();
7495 last RP;
7496 }
7497 } # RP
7498 }
7499 }
7500
7501 ## -- Rewrite the |parentNode| properties
7502 for my $nc (@new_child) {
7503
7504
7505 {
7506
7507
7508 $nc->{
7509 'b'
7510 }->{${$nc->{
7511 'id'
7512 }}}
7513 ->{'parent'} = $self->{
7514 'id'
7515 };
7516
7517
7518 }
7519
7520 ;
7521 }
7522
7523 my $children;
7524
7525
7526 {
7527
7528
7529 $children = $self->{
7530 'b'
7531 }->{${$self->{
7532 'id'
7533 }}}
7534 ->{'child'};
7535
7536
7537 }
7538
7539 ;
7540
7541
7542
7543 ;
7544
7545
7546
7547 ;
7548
7549
7550
7551 {
7552
7553
7554 ## -- Replaces the node
7555 splice @$children, $index, 1, map {
7556
7557 $_->{'id'}
7558
7559 } @new_child;
7560
7561
7562 {
7563
7564 CORE::delete
7565 $oldChild->{
7566 'b'
7567 }->{${$oldChild->{
7568 'id'
7569 }}}
7570 ->{'parent'};
7571
7572
7573 }
7574
7575 ;
7576 $r = $oldChild;
7577
7578
7579
7580 }
7581
7582 ;
7583
7584
7585
7586 }
7587
7588
7589 ;}
7590
7591 ;
7592
7593
7594 }
7595
7596 ;
7597
7598
7599 }
7600 $r}
7601 sub node_name ($;$) {
7602 if (@_ == 1) {my ($self) = @_;
7603 my $r = '';
7604
7605 {
7606
7607 my
7608 $prefix;
7609
7610
7611 {
7612
7613
7614 $prefix = $self->{
7615 'b'
7616 }->{${$self->{
7617 'id'
7618 }}}
7619 ->{'pfx'};
7620
7621
7622 }
7623
7624 ;
7625 my $lname;
7626
7627
7628 {
7629
7630
7631 $lname = $self->{
7632 'b'
7633 }->{${$self->{
7634 'id'
7635 }}}
7636 ->{'ln'};
7637
7638
7639 }
7640
7641 ;
7642 $r = defined $prefix ? $$prefix.':'.$$lname : $$lname;
7643
7644
7645 }
7646 $r;
7647 } else {my ($self) = @_;
7648 report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Element::ManakaiDOMAttr', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'node_name';
7649 }
7650 }
7651 sub name ($;$) {
7652 if (@_ == 1) {my ($self) = @_;
7653 my $r = '';
7654
7655 {
7656
7657 my
7658 $prefix;
7659
7660
7661 {
7662
7663
7664 $prefix = $self->{
7665 'b'
7666 }->{${$self->{
7667 'id'
7668 }}}
7669 ->{'pfx'};
7670
7671
7672 }
7673
7674 ;
7675 my $lname;
7676
7677
7678 {
7679
7680
7681 $lname = $self->{
7682 'b'
7683 }->{${$self->{
7684 'id'
7685 }}}
7686 ->{'ln'};
7687
7688
7689 }
7690
7691 ;
7692 $r = defined $prefix ? $$prefix.':'.$$lname : $$lname;
7693
7694
7695 }
7696 $r;
7697 } else {my ($self) = @_;
7698 report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Element::ManakaiDOMAttr', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'name';
7699 }
7700 }
7701 sub node_value ($;$) {
7702 if (@_ == 1) {my ($self) = @_;
7703 my $r = '';
7704
7705 {
7706
7707
7708 {
7709
7710 local $Error::Depth = $Error::Depth + 1;
7711
7712 {
7713
7714
7715
7716 $r = '';
7717 for my $child (@{$self->
7718 child_nodes
7719 }) {
7720 if ($child->
7721 node_type
7722 ==
7723
7724 5
7725 ) {
7726 my $v = $child->
7727 text_content
7728 ;
7729 $v =~ s/[\x09\x0A\x0D]/ /;
7730 $r .= $v;
7731 } else {
7732 $r .= $child->
7733 text_content
7734 ;
7735 }
7736 } # childNodes
7737 my $vt;
7738
7739
7740 {
7741
7742
7743 $vt = $self->{
7744 'b'
7745 }->{${$self->{
7746 'id'
7747 }}}
7748 ->{'at'};
7749
7750
7751 }
7752
7753 ;
7754 unless (not defined $vt or
7755 $vt ==
7756 0 or
7757
7758 $vt ==
7759 11 or
7760
7761 $vt ==
7762 1
7763 ) {
7764 $r =~ s/\A\x20+//;
7765 $r =~ s/\x20+\z//;
7766 $r =~ s/\x20+/ /g;
7767 }
7768
7769 if (defined $vt and $vt ==
7770 2 and
7771
7772 $self->
7773 owner_document
7774 ->
7775 dom_config
7776
7777 ->
7778 get_parameter
7779 (
7780 'http://suika.fam.cx/www/2006/dom-config/xml-id'
7781 )) {
7782 $r =~ s/[\x09\x0A\x0D\x20]+/ /g;
7783 $r =~ s/\A //;
7784 $r =~ s/ \z//;
7785 }
7786
7787
7788
7789 }
7790
7791
7792 ;}
7793
7794 ;
7795
7796
7797 }
7798 $r;
7799 } else {my ($self, $given) = @_;
7800
7801 {
7802
7803
7804 {
7805
7806
7807 {
7808
7809 if
7810 ($self->
7811 manakai_read_only
7812 ) {
7813
7814 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#NOMOD_THIS', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/NodeReadOnlyError+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest';
7815
7816 ;
7817 }
7818
7819
7820 }
7821
7822 ;
7823
7824 my @__old_children = @{$self->
7825 child_nodes
7826 };
7827 for my $__old_child (@__old_children) {
7828
7829
7830 {
7831
7832 CORE::delete
7833 $__old_child->{
7834 'b'
7835 }->{${$__old_child->{
7836 'id'
7837 }}}
7838 ->{'parent'};
7839
7840
7841 }
7842
7843 ;
7844 }
7845
7846 my @__new_children;
7847 if (defined $given and length $given) {
7848 my $__text = $self->owner_document->
7849 create_text_node
7850 ($given);
7851 push @__new_children,
7852 $__text->{'id'}
7853 ;
7854
7855
7856 {
7857
7858
7859 $__text->{
7860 'b'
7861 }->{${$__text->{
7862 'id'
7863 }}}
7864 ->{'parent'} = $self->{
7865 'id'
7866 };
7867
7868
7869 }
7870
7871 ;
7872 }
7873
7874
7875
7876 {
7877
7878
7879 $self->{
7880 'b'
7881 }->{${$self->{
7882 'id'
7883 }}}
7884 ->{'child'} = \@__new_children;
7885
7886
7887 }
7888
7889 ;
7890
7891
7892 }
7893
7894 ;
7895
7896
7897 }
7898 }
7899 }
7900 sub manakai_append_text ($$) {
7901 my ($self, $string) = @_;
7902 my $r;
7903
7904 {
7905
7906
7907 {
7908
7909 local $Error::Depth = $Error::Depth + 1;
7910
7911 {
7912
7913
7914 my
7915 $lc = $self->
7916 last_child
7917 ;
7918 if (defined $lc and
7919 $lc->
7920 node_type
7921 ==
7922 3
7923 ) {
7924 $lc->
7925 manakai_append_text
7926
7927 (ref $string eq 'SCALAR' ? $string : \$string);
7928 } else {
7929 my $text = $self->
7930 owner_document
7931
7932 ->
7933 create_text_node
7934
7935 (ref $string eq 'SCALAR' ? $$string : $string);
7936 $self->
7937 append_child
7938 ($text);
7939 }
7940 $r = $self;
7941
7942
7943
7944 }
7945
7946
7947 ;}
7948
7949 ;
7950
7951
7952 }
7953 $r}
7954 sub get_feature ($$$) {
7955 my ($self, $feature, $version) = @_;
7956
7957 {
7958
7959
7960 $feature = lc $feature;
7961
7962
7963 }
7964
7965 {
7966
7967
7968 $version = '' unless defined $version;
7969
7970
7971 }
7972 my $r;
7973
7974 {
7975
7976
7977 $feature =~ s/^\+//;
7978
7979
7980 {
7981
7982 if
7983 ($Message::Util::AutoLoad::Registry::Feature->{$feature}->{$version}) {
7984 $r = $self;
7985 }
7986
7987
7988 }
7989
7990 ;
7991 unless (defined $r) {
7992
7993
7994 {
7995
7996 local $Error::Depth = $Error::Depth + 1;
7997
7998 {
7999
8000
8001
8002 $r = $self->SUPER::get_feature ($feature, $version);
8003
8004
8005
8006 }
8007
8008
8009 ;}
8010
8011 ;
8012 }
8013
8014
8015 }
8016 $r}
8017 sub base_uri ($;$) {
8018 if (@_ == 1) {my ($self) = @_;
8019 my $r = '';
8020
8021 {
8022
8023
8024 {
8025
8026 local $Error::Depth = $Error::Depth + 1;
8027
8028 {
8029
8030
8031 my
8032 $oe = $self->
8033 owner_element
8034 ;
8035 if ($oe) {
8036 my $ln = $self->local_name;
8037 my $nsuri = $self->namespace_uri;
8038 if (($ln eq 'base' and defined $nsuri and $nsuri eq
8039 'http://www.w3.org/XML/1998/namespace'
8040 ) or
8041 ($ln eq 'xml:base' and not defined $nsuri)) {
8042 my $oep = $oe->
8043 parent_node
8044 ;
8045 if ($oep) {
8046 $r = $oep->
8047 base_uri
8048 ;
8049 } else {
8050 $r = $self->
8051 owner_document
8052 ->
8053 base_uri
8054 ;
8055 }
8056 } else {
8057 $r = $oe->
8058 base_uri
8059 ;
8060 }
8061 } else {
8062 $r = $self->
8063 owner_document
8064 ->
8065 base_uri
8066 ;
8067 }
8068
8069
8070
8071 }
8072
8073
8074 ;}
8075
8076 ;
8077
8078
8079 }
8080 $r;
8081 } else {my ($self) = @_;
8082 report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Element::ManakaiDOMAttr', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'base_uri';
8083 }
8084 }
8085 sub owner_element ($;$) {
8086 if (@_ == 1) {my ($self) = @_;
8087 my $r;
8088
8089 {
8090
8091
8092 {
8093
8094 my
8095 $__v = $self->{
8096 'b'
8097 }->{${$self->{
8098 'id'
8099 }}}
8100 ->{'owner'};
8101 if (defined $__v) {
8102
8103
8104 {
8105
8106
8107 $r = ${$self->{'b'}->{${$__v}}->{
8108 'cls'
8109 }}->___create_node_ref ({
8110
8111 'id'
8112 => $__v,
8113
8114 'b'
8115 => $self->{'b'},
8116 }, {
8117 });
8118 $self->{'b'}->{${$__v}}->{
8119 'rc'
8120 }++;
8121
8122
8123 }
8124
8125 ;
8126 }
8127
8128
8129 }
8130
8131 ;
8132
8133
8134 }
8135 $r;
8136 } else {my ($self) = @_;
8137 report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Element::ManakaiDOMAttr', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'owner_element';
8138 }
8139 }
8140 sub specified ($;$) {
8141 if (@_ == 1) {my ($self) = @_;
8142 my $r = 0;
8143
8144 {
8145
8146
8147 {
8148
8149
8150 $r = $self->{
8151 'b'
8152 }->{${$self->{
8153 'id'
8154 }}}
8155 ->{'specified'};
8156
8157
8158 }
8159
8160 ;
8161 unless ($r) {
8162 my $oe;
8163
8164
8165 {
8166
8167
8168 $oe = $self->{
8169 'b'
8170 }->{${$self->{
8171 'id'
8172 }}}
8173 ->{'owner'};
8174
8175
8176 }
8177
8178 ;
8179 unless (defined $oe) {
8180 $r =
8181 1
8182 ;
8183 }
8184 }
8185
8186
8187 }
8188 $r;
8189 } else {my ($self, $given) = @_;
8190
8191 {
8192
8193
8194 {
8195
8196 if
8197 ($self->
8198 manakai_read_only
8199 ) {
8200
8201 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#NOMOD_THIS', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/NodeReadOnlyError+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest';
8202
8203 ;
8204 }
8205
8206
8207 }
8208
8209 ;
8210 unless ($given) {
8211 my $oe;
8212
8213
8214 {
8215
8216
8217 $oe = $self->{
8218 'b'
8219 }->{${$self->{
8220 'id'
8221 }}}
8222 ->{'owner'};
8223
8224
8225 }
8226
8227 ;
8228 $given =
8229 1 unless
8230 defined $oe;
8231 }
8232
8233
8234 {
8235
8236
8237 $self->{
8238 'b'
8239 }->{${$self->{
8240 'id'
8241 }}}
8242 ->{'specified'} = $given;
8243
8244
8245 }
8246
8247 ;
8248
8249
8250 }
8251 }
8252 }
8253 sub value ($;$) {
8254 if (@_ == 1) {my ($self) = @_;
8255 my $r = '';
8256
8257 {
8258
8259
8260 {
8261
8262 local $Error::Depth = $Error::Depth + 1;
8263
8264 {
8265
8266
8267
8268 $r = '';
8269 for my $child (@{$self->
8270 child_nodes
8271 }) {
8272 if ($child->
8273 node_type
8274 ==
8275
8276 5
8277 ) {
8278 my $v = $child->
8279 text_content
8280 ;
8281 $v =~ s/[\x09\x0A\x0D]/ /;
8282 $r .= $v;
8283 } else {
8284 $r .= $child->
8285 text_content
8286 ;
8287 }
8288 } # childNodes
8289 my $vt;
8290
8291
8292 {
8293
8294
8295 $vt = $self->{
8296 'b'
8297 }->{${$self->{
8298 'id'
8299 }}}
8300 ->{'at'};
8301
8302
8303 }
8304
8305 ;
8306 unless (not defined $vt or
8307 $vt ==
8308 0 or
8309
8310 $vt ==
8311 11 or
8312
8313 $vt ==
8314 1
8315 ) {
8316 $r =~ s/\A\x20+//;
8317 $r =~ s/\x20+\z//;
8318 $r =~ s/\x20+/ /g;
8319 }
8320
8321 if (defined $vt and $vt ==
8322 2 and
8323
8324 $self->
8325 owner_document
8326 ->
8327 dom_config
8328
8329 ->
8330 get_parameter
8331 (
8332 'http://suika.fam.cx/www/2006/dom-config/xml-id'
8333 )) {
8334 $r =~ s/[\x09\x0A\x0D\x20]+/ /g;
8335 $r =~ s/\A //;
8336 $r =~ s/ \z//;
8337 }
8338
8339
8340
8341 }
8342
8343
8344 ;}
8345
8346 ;
8347
8348
8349 }
8350 $r;
8351 } else {my ($self, $given) = @_;
8352
8353 {
8354
8355
8356 {
8357
8358
8359 {
8360
8361 if
8362 ($self->
8363 manakai_read_only
8364 ) {
8365
8366 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#NOMOD_THIS', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/NodeReadOnlyError+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest';
8367
8368 ;
8369 }
8370
8371
8372 }
8373
8374 ;
8375
8376 my @__old_children = @{$self->
8377 child_nodes
8378 };
8379 for my $__old_child (@__old_children) {
8380
8381
8382 {
8383
8384 CORE::delete
8385 $__old_child->{
8386 'b'
8387 }->{${$__old_child->{
8388 'id'
8389 }}}
8390 ->{'parent'};
8391
8392
8393 }
8394
8395 ;
8396 }
8397
8398 my @__new_children;
8399 if (defined $given and length $given) {
8400 my $__text = $self->owner_document->
8401 create_text_node
8402 ($given);
8403 push @__new_children,
8404 $__text->{'id'}
8405 ;
8406
8407
8408 {
8409
8410
8411 $__text->{
8412 'b'
8413 }->{${$__text->{
8414 'id'
8415 }}}
8416 ->{'parent'} = $self->{
8417 'id'
8418 };
8419
8420
8421 }
8422
8423 ;
8424 }
8425
8426
8427
8428 {
8429
8430
8431 $self->{
8432 'b'
8433 }->{${$self->{
8434 'id'
8435 }}}
8436 ->{'child'} = \@__new_children;
8437
8438
8439 }
8440
8441 ;
8442
8443
8444 }
8445
8446 ;
8447
8448
8449 }
8450 }
8451 }
8452 sub schema_type_info ($;$) {
8453 if (@_ == 1) {my ($self) = @_;
8454 my $r;
8455
8456 {
8457
8458 my
8459 $type;
8460
8461
8462 {
8463
8464
8465 $type = $self->{
8466 'b'
8467 }->{${$self->{
8468 'id'
8469 }}}
8470 ->{'at'};
8471
8472
8473 }
8474
8475 ;
8476
8477
8478 {
8479
8480 my
8481 $v = $type || 0;
8482 $r = bless \$v,
8483 'Message::DOM::Element::ManakaiDOMDTDTypeInfo'
8484 ;
8485
8486
8487 }
8488
8489 ;
8490
8491
8492 }
8493 $r;
8494 } else {my ($self) = @_;
8495 report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Element::ManakaiDOMAttr', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'schema_type_info';
8496 }
8497 }
8498 sub is_id ($;$) {
8499 if (@_ == 1) {my ($self) = @_;
8500 my $r = 0;
8501
8502 {
8503
8504 T:
8505 {
8506 ## DTD Attribute Type
8507 my $type;
8508
8509
8510 {
8511
8512
8513 $type = $self->{
8514 'b'
8515 }->{${$self->{
8516 'id'
8517 }}}
8518 ->{'at'};
8519
8520
8521 }
8522
8523 ;
8524 if (defined $type and $type ==
8525 2
8526 ) {
8527 $r =
8528 1
8529 ;
8530 last T;
8531 }
8532
8533 ## User-determined ID
8534 my $udid;
8535
8536
8537 {
8538
8539
8540 $udid = $self->{
8541 'b'
8542 }->{${$self->{
8543 'id'
8544 }}}
8545 ->{'isudid'};
8546
8547
8548 }
8549
8550 ;
8551 if ($udid) {
8552 $r =
8553 1
8554 ;
8555 last T;
8556 }
8557
8558 ## Application-determined ID
8559 my $nsuri = $self->
8560 namespace_uri
8561 ;
8562 my $ln = $self->
8563 local_name
8564 ;
8565 if (defined $nsuri and $nsuri eq
8566 'http://www.w3.org/XML/1998/namespace' and
8567
8568 $ln eq 'id') {
8569 $r =
8570 1
8571 ;
8572 last T;
8573 } elsif (not defined $nsuri and $ln eq 'xml:id') {
8574 $r =
8575 1
8576 ;
8577 last T;
8578 }
8579 } # T
8580
8581
8582 }
8583 $r;
8584 } else {my ($self, $given) = @_;
8585
8586 {
8587
8588
8589 {
8590
8591 if
8592 ($self->
8593 manakai_read_only
8594 ) {
8595
8596 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#NOMOD_THIS', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/NodeReadOnlyError+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest';
8597
8598 ;
8599 }
8600
8601
8602 }
8603
8604 ;
8605
8606
8607 {
8608
8609
8610 $self->{
8611 'b'
8612 }->{${$self->{
8613 'id'
8614 }}}
8615 ->{'isudid'} = $given;
8616
8617
8618 }
8619
8620 ;
8621
8622
8623 }
8624 }
8625 }
8626 sub manakai_attribute_type ($;$) {
8627 if (@_ == 1) {my ($self) = @_;
8628 my $r = 0;
8629
8630 {
8631
8632
8633 {
8634
8635
8636 $r = $self->{
8637 'b'
8638 }->{${$self->{
8639 'id'
8640 }}}
8641 ->{'at'};
8642
8643
8644 }
8645
8646 ;
8647 $r =
8648 0 unless
8649 defined $r;
8650
8651
8652 }
8653 $r;
8654 } else {my ($self, $given) = @_;
8655
8656 {
8657
8658
8659 {
8660
8661 if
8662 ($self->
8663 manakai_read_only
8664 ) {
8665
8666 report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#NOMOD_THIS', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/NodeReadOnlyError+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest';
8667
8668 ;
8669 }
8670
8671
8672 }
8673
8674 ;
8675
8676
8677 {
8678
8679
8680 $self->{
8681 'b'
8682 }->{${$self->{
8683 'id'
8684 }}}
8685 ->{'at'} = $given;
8686
8687
8688 }
8689
8690 ;
8691
8692
8693 }
8694 }
8695 }
8696 $Message::DOM::DOMFeature::ClassInfo->{q<Message::DOM::Element::ManakaiDOMAttr>}->{has_feature} = {'core',
8697 {'',
8698 '1',
8699 '1.0',
8700 '1',
8701 '2.0',
8702 '1',
8703 '3.0',
8704 '1'},
8705 'xml',
8706 {'',
8707 '1',
8708 '1.0',
8709 '1',
8710 '2.0',
8711 '1',
8712 '3.0',
8713 '1'},
8714 'xmlversion',
8715 {'',
8716 '1',
8717 '1.0',
8718 '1',
8719 '1.1',
8720 '1'}};
8721 $Message::DOM::ClassPoint{q<Message::DOM::Element::ManakaiDOMAttr>} = 14.1;
8722 $Message::Util::Grove::ClassProp{q<Message::DOM::Element::ManakaiDOMAttr>} = {'o0',
8723 ['owner'],
8724 's1a',
8725 ['child'],
8726 'w0',
8727 ['od']};
8728 package Message::DOM::IFLatest::TypeInfo;
8729 our $VERSION = 20061203.0432;
8730 sub DERIVATION_RESTRICTION () {
8731 1}
8732 sub DERIVATION_EXTENSION () {
8733 2}
8734 sub DERIVATION_UNION () {
8735 4}
8736 sub DERIVATION_LIST () {
8737 8}
8738 package Message::DOM::Element::ManakaiDOMDTDTypeInfo;
8739 our $VERSION = 20061203.0432;
8740 push our @ISA, 'Message::DOM::IF::TypeInfo',
8741 'Message::DOM::IFLatest::TypeInfo',
8742 'Message::DOM::IFLevel3::TypeInfo';
8743 sub type_name ($;$) {
8744 if (@_ == 1) {my ($self) = @_;
8745 my $r = '';
8746
8747 {
8748
8749
8750 $r = {
8751
8752 1
8753 => 'CDATA',
8754
8755 2
8756 => 'ID',
8757
8758 3
8759 => 'IDREF',
8760
8761 4
8762 => 'IDREFS',
8763
8764 5
8765 => 'ENTITY',
8766
8767 6
8768 => 'ENTITIES',
8769
8770 7
8771 => 'NMTOKEN',
8772
8773 8
8774 => 'NMTOKENS',
8775
8776 9
8777 => 'NOTATION',
8778
8779 10
8780 => 'ENUMERATION',
8781 }->{$$self};
8782
8783
8784 }
8785 $r;
8786 } else {my ($self) = @_;
8787 report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Element::ManakaiDOMDTDTypeInfo', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'type_name';
8788 }
8789 }
8790 sub type_namespace ($;$) {
8791 if (@_ == 1) {my ($self) = @_;
8792 my $r = '';
8793
8794 {
8795
8796
8797 $r = {
8798
8799 1
8800 =>
8801 1
8802 ,
8803
8804 2
8805 =>
8806 1
8807 ,
8808
8809 3
8810 =>
8811 1
8812 ,
8813
8814 4
8815 =>
8816 1
8817 ,
8818
8819 5
8820 =>
8821 1
8822 ,
8823
8824 6
8825 =>
8826 1
8827 ,
8828
8829 7
8830 =>
8831 1
8832 ,
8833
8834 8
8835 =>
8836 1
8837 ,
8838
8839 9
8840 =>
8841 1
8842 ,
8843
8844 10
8845 =>
8846 1
8847 ,
8848 }->{$$self} ?
8849 'http://www.w3.org/TR/REC-xml' :
8850 undef;
8851
8852
8853 }
8854 $r;
8855 } else {my ($self) = @_;
8856 report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Element::ManakaiDOMDTDTypeInfo', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'type_namespace';
8857 }
8858 }
8859 sub is_derived_from ($$$$) {
8860 my ($self, $typeNamespaceArg, $typeNameArg, $derivationMethod) = @_;
8861 my $r = 0;
8862
8863
8864 $r}
8865 use overload
8866 bool => sub () {1},
8867 'eq' => sub ($$) {
8868 my ($self, $t) = @_;
8869 my $r = 0;
8870
8871 {
8872
8873
8874 {
8875
8876 local $Error::Depth = $Error::Depth + 1;
8877
8878 {
8879
8880
8881 if
8882 (UNIVERSAL::isa ($t,
8883 'Message::DOM::IFLatest::TypeInfo'
8884 )) {
8885 my $ln1 = $self->
8886 type_name
8887 ;
8888 my $ln2 = $t->
8889 type_name
8890 ;
8891 if ((defined $ln1 and defined $ln2 and $ln1 eq $ln2) or
8892 (not defined $ln1 or not defined $ln2)) {
8893 my $ns1 = $self->
8894 type_namespace
8895 ;
8896 my $ns2 = $t->
8897 type_namespace
8898 ;
8899 if ((defined $ns1 and defined $ns2 and $ns1 eq $ns2) or
8900 (not defined $ns1 and not defined $ns2)) {
8901 $r =
8902 1
8903 ;
8904 }
8905 }
8906 }
8907
8908
8909
8910 }
8911
8912
8913 ;}
8914
8915 ;
8916
8917
8918 }
8919 $r}
8920 ,
8921 fallback => 1;
8922 $Message::DOM::DOMFeature::ClassInfo->{q<Message::DOM::Element::ManakaiDOMDTDTypeInfo>}->{has_feature} = {'core',
8923 {'',
8924 '1',
8925 '3.0',
8926 '1'},
8927 'xml',
8928 {'',
8929 '1',
8930 '3.0',
8931 '1'},
8932 'xmlversion',
8933 {'',
8934 '1',
8935 '1.0',
8936 '1',
8937 '1.1',
8938 '1'}};
8939 $Message::DOM::ClassPoint{q<Message::DOM::Element::ManakaiDOMDTDTypeInfo>} = 8.1;
8940 for ($Message::DOM::IF::Attr::, $Message::DOM::IF::Element::, $Message::DOM::IF::Node::, $Message::DOM::IF::TypeInfo::, $Message::DOM::IFLatest::Node::, $Message::DOM::IFLevel1::Attr::, $Message::DOM::IFLevel1::Element::, $Message::DOM::IFLevel1::Node::, $Message::DOM::IFLevel2::Attr::, $Message::DOM::IFLevel2::Element::, $Message::DOM::IFLevel2::Node::, $Message::DOM::IFLevel3::Attr::, $Message::DOM::IFLevel3::Element::, $Message::DOM::IFLevel3::Node::, $Message::DOM::IFLevel3::TypeInfo::){}
8941 ## License: <http://suika.fam.cx/~wakaba/archive/2004/8/18/license#Perl+MPL>
8942 1;

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24