/[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.18 - (show annotations) (download)
Sun Dec 31 02:39:38 2006 UTC (17 years, 10 months ago) by wakaba
Branch: MAIN
Changes since 1.17: +74 -46 lines 
++ manakai/lib/Message/DOM/ChangeLog	31 Dec 2006 02:39:19 -0000
2006-12-31  Wakaba  <wakaba@suika.fam.cx>

	* Element.dis (createElementNS): If an array reference
	is specified as the |qualifiedName| parameter,
	don't set the first item as the local name
	even if the second item is not specified (or
	specified as |undef|).
	(createElementNS, setAttribute, setAttributeNS,
	removeAttribute, removeAttributeNS,
	setAttributeNode, setAttributeNodeNS,
	removeAttributeNode, removeAttributeNodeNS): Sets
	or removes the |tc:contentAttributeList| value.

	* TreeCore.dis (AttrMap.item): Caches the result
	of sorting of content attribute names.
	(getAttrMap, getElementTypeDefNodeMap,
	getAttrDefNodeMap, getEntityNodeMap, getNotationNodeMap): Removed.
	(tc:contentAttributeList): New property.
1 #!/usr/bin/perl
2 ## This file is automatically generated
3 ## at 2006-12-31T02:08:06+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#all>.
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 = 20061231.0208;
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::IF::TypeInfo::DERIVATION_EXTENSION',
26 'DERIVATION_LIST',
27 'Message::DOM::IF::TypeInfo::DERIVATION_LIST',
28 'DERIVATION_RESTRICTION',
29 'Message::DOM::IF::TypeInfo::DERIVATION_RESTRICTION',
30 'DERIVATION_UNION',
31 'Message::DOM::IF::TypeInfo::DERIVATION_UNION'}->{$al}) {
32 no strict 'refs';
33 *{$AUTOLOAD} = \&{{'DERIVATION_EXTENSION',
34 'Message::DOM::IF::TypeInfo::DERIVATION_EXTENSION',
35 'DERIVATION_LIST',
36 'Message::DOM::IF::TypeInfo::DERIVATION_LIST',
37 'DERIVATION_RESTRICTION',
38 'Message::DOM::IF::TypeInfo::DERIVATION_RESTRICTION',
39 'DERIVATION_UNION',
40 'Message::DOM::IF::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 = 20061231.0208;
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 if (((not defined $version or $version eq '1.0') and
103 not
104 ($tagName =~ /\A\p{InXML_NameStartChar10}\p{InXMLNameChar10}*\z/)
105 ) or
106 (defined $version and $version eq '1.1' and
107 not
108 ($tagName =~ /\A\p{InXMLNameStartChar11}\p{InXMLNameChar11}*\z/)
109 )) {
110
111 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' => 'http://suika.fam.cx/~wakaba/archive/2004/dom/main#ensureXMLName', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => '$INPUT_PARAM_NAME';
112
113 ;
114 }
115 }
116
117
118 }
119
120 ;
121 }
122
123
124 {
125
126 local $Error::Depth = $Error::Depth + 1;
127
128 {
129
130
131
132 $self->
133 strict_error_checking
134 (
135 0
136 );
137 $r = $self->
138 create_element_ns
139 (
140 undef
141 , [
142 undef
143 , $tagName]);
144 $self->
145 strict_error_checking
146 ($strict);
147
148
149
150 }
151
152
153 ;}
154
155 ;
156
157
158 }
159 $r}
160 sub create_element_ns ($$$) {
161 my ($self, $namespaceURI, $qualifiedName) = @_;
162
163 {
164
165 if
166 (CORE::defined $namespaceURI and CORE::length $namespaceURI == 0) {
167 require Message::DOM::DOMMain;
168
169 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:1167522123:25685:fj3zF510';
170
171 ;
172
173 $namespaceURI = undef;
174 }
175
176
177 }
178 my $r;
179
180 {
181
182 my
183 ($prefix, $lname);
184 if (ref $qualifiedName eq 'ARRAY') {
185 ($prefix, $lname) = @$qualifiedName;
186 $qualifiedName = defined $prefix ? $prefix.':'.$lname : $lname;
187 } else {
188 ($prefix, $lname) = split /:/, $qualifiedName, 2;
189 ($prefix, $lname) = (
190 undef
191 , $prefix) unless defined $lname;
192 }
193
194 if ($self->
195 strict_error_checking
196 ) {
197 my $version = $self->
198 xml_version
199 ;
200
201
202 {
203
204 if
205 (defined $version and $version eq '1.1') {
206 unless (
207 ($qualifiedName =~ /\A\p{InXMLNameStartChar11}\p{InXMLNameChar11}*\z/)
208 ) {
209
210 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' => 'http://suika.fam.cx/~wakaba/archive/2004/dom/main#ensureXMLQName', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => '$INPUT_NAME';
211
212 ;
213 }
214 unless (
215 ($qualifiedName =~ /\A\p{InXMLNCNameStartChar11}\p{InXMLNCNameChar11}*(?::\p{InXMLNCNameStartChar11}\p{InXMLNCNameChar11}*)?\z/)
216 ) {
217
218 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' => 'http://suika.fam.cx/~wakaba/archive/2004/dom/main#ensureXMLQName', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => '$INPUT_NAME';
219
220 ;
221 }
222 } else {
223 unless (
224 ($qualifiedName =~ /\A\p{InXML_NameStartChar10}\p{InXMLNameChar10}*\z/)
225 ) {
226
227 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' => 'http://suika.fam.cx/~wakaba/archive/2004/dom/main#ensureXMLQName', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => '$INPUT_NAME';
228
229 ;
230 }
231 unless (
232 ($qualifiedName =~ /\A\p{InXML_NCNameStartChar10}\p{InXMLNCNameChar10}*(?::\p{InXML_NCNameStartChar10}\p{InXMLNCNameChar10}*)?\z/)
233 ) {
234
235 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' => 'http://suika.fam.cx/~wakaba/archive/2004/dom/main#ensureXMLQName', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => '$INPUT_NAME';
236
237 ;
238 }
239 }
240
241
242 }
243
244 ;
245
246
247 {
248
249 if
250 (defined $prefix) {
251 if (not defined $namespaceURI) {
252
253 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' => 'http://suika.fam.cx/~wakaba/archive/2004/dom/main#checkXMLNamesQName';
254
255 ;
256 } elsif ($prefix eq 'xml' and $namespaceURI ne
257 'http://www.w3.org/XML/1998/namespace'
258 ) {
259
260 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' => 'http://suika.fam.cx/~wakaba/archive/2004/dom/main#checkXMLNamesQName';
261
262 ;
263 } elsif ($prefix eq 'xmlns' and $namespaceURI ne
264 'http://www.w3.org/2000/xmlns/'
265 ) {
266
267 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' => 'http://suika.fam.cx/~wakaba/archive/2004/dom/main#checkXMLNamesQName';
268
269 ;
270 } elsif ($namespaceURI eq
271 'http://www.w3.org/XML/1998/namespace' and
272 $prefix ne 'xml') {
273
274 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' => 'http://suika.fam.cx/~wakaba/archive/2004/dom/main#checkXMLNamesQName';
275
276 ;
277 } elsif ($namespaceURI eq
278 'http://www.w3.org/2000/xmlns/' and
279 $prefix ne 'xmlns') {
280
281 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' => 'http://suika.fam.cx/~wakaba/archive/2004/dom/main#checkXMLNamesQName';
282
283 ;
284 }
285 } else { ## No prefix
286 if (not defined $namespaceURI) {
287 #
288 } elsif ($namespaceURI eq
289 'http://www.w3.org/2000/xmlns/' and
290 $lname ne 'xmlns') {
291
292 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' => 'http://suika.fam.cx/~wakaba/archive/2004/dom/main#checkXMLNamesQName';
293
294 ;
295 }
296 }
297
298
299 }
300
301 ;
302 if (defined $namespaceURI and $namespaceURI eq
303 'http://www.w3.org/2000/xmlns/' and
304
305 ($qualifiedName eq 'xmlns' or
306 (defined $prefix and $prefix eq 'xmlns'))) {
307
308 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';
309
310 ;
311 }
312 }
313
314 ## -- Choose the most apppropriate class for the element
315 my $class =
316 'Message::DOM::Element::ManakaiDOMElement'
317 ;
318 my $nsuri = defined $namespaceURI ? $namespaceURI : '';
319
320 ## Use cases:
321 ## - |html5:a| element type
322 ## - |html5:*| element types
323 A: for my $nm (
324 [$nsuri, $lname],
325 [$nsuri, '*'],
326 ) {
327 unless ($Message::DOM::Element::ElementClass
328 ->{$nm->[0]}->{$nm->[1]}) {
329 if ($Message::Util::AutoLoad::Registry::ElementType
330 ->{$nm->[0]}->{$nm->[1]}) {
331 eval qq{require
332 $Message::Util::AutoLoad::Registry::ElementType->{
333 $nm->[0]}->{$nm->[1]}->{module}};
334 die $@ if $@;
335 }
336 }
337
338 if ($Message::DOM::Element::ElementClass
339 ->{$nm->[0]}->{$nm->[1]}) {
340 $class = $Message::DOM::Element::ElementClass
341 ->{$nm->[0]}->{$nm->[1]};
342 last A;
343 }
344 } # A
345
346 $r = bless \{
347
348 'od'
349 => $self,
350
351 'child'
352 => [],
353
354 'attr'
355 => {},
356
357 'sattrs'
358 => [],
359 }, $class;
360 Scalar::Util::weaken ($$r->{
361 'od'
362 });
363
364
365 {
366
367 if
368 (defined $namespaceURI) {
369 if (ref $namespaceURI eq 'SCALAR') {
370 $$r->{'ns'} = $namespaceURI;
371 } elsif (defined $Message::Util::ManakaiStringRef::Value{$namespaceURI}) {
372 $$r->{'ns'} = $Message::Util::ManakaiStringRef::Value{$namespaceURI};
373 } else {
374 require Scalar::Util;
375 $$r->{'ns'} = $Message::Util::ManakaiStringRef::Value{$namespaceURI} = \($namespaceURI);
376 Scalar::Util::weaken ($Message::Util::ManakaiStringRef::Value{$namespaceURI});
377 }
378 } else {
379 CORE::delete $$r->{'ns'};
380 }
381
382
383 }
384
385 ;
386
387
388 {
389
390 if
391 (defined $prefix) {
392 if (ref $prefix eq 'SCALAR') {
393 $$r->{'pfx'} = $prefix;
394 } elsif (defined $Message::Util::ManakaiStringRef::Value{$prefix}) {
395 $$r->{'pfx'} = $Message::Util::ManakaiStringRef::Value{$prefix};
396 } else {
397 require Scalar::Util;
398 $$r->{'pfx'} = $Message::Util::ManakaiStringRef::Value{$prefix} = \($prefix);
399 Scalar::Util::weaken ($Message::Util::ManakaiStringRef::Value{$prefix});
400 }
401 } else {
402 CORE::delete $$r->{'pfx'};
403 }
404
405
406 }
407
408 ;
409
410
411 {
412
413 if
414 (defined $lname) {
415 if (ref $lname eq 'SCALAR') {
416 $$r->{'ln'} = $lname;
417 } elsif (defined $Message::Util::ManakaiStringRef::Value{$lname}) {
418 $$r->{'ln'} = $Message::Util::ManakaiStringRef::Value{$lname};
419 } else {
420 require Scalar::Util;
421 $$r->{'ln'} = $Message::Util::ManakaiStringRef::Value{$lname} = \($lname);
422 Scalar::Util::weaken ($Message::Util::ManakaiStringRef::Value{$lname});
423 }
424 } else {
425 CORE::delete $$r->{'ln'};
426 }
427
428
429 }
430
431 ;
432
433 ## Default attributes
434
435
436 {
437
438
439 {
440
441 local $Error::Depth = $Error::Depth + 1;
442
443 {
444
445
446 XDA:
447 {
448 my $__cfg = $self->
449 dom_config
450 ;
451 last XDA unless $__cfg->
452 get_parameter
453
454 (
455 'http://suika.fam.cx/www/2006/dom-config/dtd-default-attribute'
456 );
457 my $__doctype = $self->
458 doctype
459 ;
460 last XDA unless defined $__doctype;
461
462 my $__et = $__doctype->
463 get_element_type_definition_node
464
465 ($qualifiedName);
466 if ($__et) {
467 my $__orig_strict = $self->
468 strict_error_checking
469 ;
470 $self->
471 strict_error_checking
472 (
473 0
474 );
475 my %__gattr;
476 my %__has_attr;
477 my %__pfx_to_uri;
478 my $__copy_asis = $__cfg->
479 get_parameter
480
481 (
482 'http://suika.fam.cx/www/2006/dom-config/clone-entity-reference-subtree'
483 );
484 $__cfg->
485 set_parameter
486
487 (
488 'http://suika.fam.cx/www/2006/dom-config/clone-entity-reference-subtree'
489 =>
490 1
491 );
492 for my $__at (@{$__et->
493 attribute_definitions
494 }) {
495 my $__at_default = $__at->
496 default_type
497 ;
498 if ($__at_default ==
499 4 or
500
501 $__at_default ==
502 1
503 ) {
504 my ($__nn1, $__nn2) = split /:/, $__at->
505 node_name
506 ;
507 if (defined $__nn2) { # prefixed
508 if ($__nn1 eq 'xmlns') {
509 ## TODO: NCName check, prefix check and NSURI check
510 my $__attr = $self->
511 create_attribute_ns
512
513 (
514 'http://www.w3.org/2000/xmlns/'
515 , [$__nn1, $__nn2]);
516 for my $__at_child (@{$__at->
517 child_nodes
518 }) {
519 $__attr->
520 append_child
521
522 ($__at_child->
523 clone_node
524 (
525 1
526 ));
527 }
528 $__attr->
529 manakai_attribute_type
530
531 ($__at->
532 declared_type
533 );
534 my $__nsuri = $__attr->
535 value
536 ;
537 ## TODO: Namespace well-formedness check (NSURI), v1.1 chk
538 $__pfx_to_uri{$__nn2} = $__nsuri;
539 $r->
540 set_attribute_node_ns
541 ($__attr);
542 ## This method changes |specified| flag
543 $__attr->
544 specified
545 (
546 0
547 );
548 $__has_attr{
549 'http://www.w3.org/2000/xmlns/'
550 }->{$__nn2} =
551 1
552 ;
553 } else {
554 ## TODO: NCName check
555 $__gattr{$__nn1}->{$__nn2} = $__at;
556 }
557 } else { # no prefixed
558 my $__attr;
559 if ($__nn1 eq 'xmlns') {
560 $__attr = $self->
561 create_attribute_ns
562
563 (
564 'http://www.w3.org/2000/xmlns/'
565 , 'xmlns');
566 $__has_attr{
567 'http://www.w3.org/2000/xmlns/'
568 }->{xmlns} =
569 1
570 ;
571 } else {
572 $__attr = $self->
573 create_attribute_ns
574
575 (
576 undef
577 , $__nn1);
578 ## TODO: NCName check
579 }
580 for my $__at_child (@{$__at->
581 child_nodes
582 }) {
583 $__attr->
584 append_child
585
586 ($__at_child->
587 clone_node
588 (
589 1
590 ));
591 }
592 $__attr->
593 manakai_attribute_type
594
595 ($__at->
596 declared_type
597 );
598 ## TODO: Namespace well-formedness check (NSURI)
599 $r->
600 set_attribute_node_ns
601 ($__attr);
602 ## This method changes |specified| flag
603 $__attr->
604 specified
605 (
606 0
607 );
608 }
609 }
610 } # attrdefs
611 for my $__pfx (keys %__gattr) {
612 my $__nsuri = $__pfx_to_uri{$__pfx};
613 unless (defined $__nsuri) {
614 ## TODO: Namespace well-formedness error
615 }
616 LN: for my $__ln (keys %{$__gattr{$__pfx}}) {
617 if ($__has_attr{defined $__nsuri ? $__nsuri : ''}->{$__ln}) {
618 ## TODO: Namespace well-formedness error
619 next LN;
620 }
621 ## TODO: NCName check, prefix check and NSURI check
622 my $__at = $__gattr{$__pfx}->{$__ln};
623 my $__attr = $self->
624 create_attribute_ns
625
626 ($__nsuri, [$__pfx, $__ln]);
627 for my $__at_child (@{$__at->
628 child_nodes
629 }) {
630 $__attr->
631 append_child
632
633 ($__at_child->
634 clone_node
635 (
636 1
637 ));
638 }
639 $__attr->
640 manakai_attribute_type
641
642 ($__at->
643 declared_type
644 );
645 $r->
646 set_attribute_node_ns
647 ($__attr);
648 ## This method changes |specified| flag
649 $__attr->
650 specified
651 (
652 0
653 );
654 $__has_attr{defined $__nsuri ? $__nsuri : ''}->{$__ln} =
655 1
656 ;
657 } # LN
658 } # pfx
659 $__cfg->
660 set_parameter
661
662 (
663 'http://suika.fam.cx/www/2006/dom-config/clone-entity-reference-subtree'
664 => $__copy_asis);
665 $self->
666 strict_error_checking
667 ($__orig_strict);
668 }
669 } # XDA
670
671
672
673 }
674
675
676 ;}
677
678 ;
679
680
681 }
682
683 ;
684
685
686 }
687 $r}
688 sub create_attribute ($$) {
689 my ($self, $name) = @_;
690 my $r;
691
692 {
693
694 my
695 $strict = $self->
696 strict_error_checking
697 ;
698 if ($strict) {
699 my $version = $self->
700 xml_version
701 ;
702
703
704 {
705
706 if
707 (defined $name) {
708 if (((not defined $version or $version eq '1.0') and
709 not
710 ($name =~ /\A\p{InXML_NameStartChar10}\p{InXMLNameChar10}*\z/)
711 ) or
712 (defined $version and $version eq '1.1' and
713 not
714 ($name =~ /\A\p{InXMLNameStartChar11}\p{InXMLNameChar11}*\z/)
715 )) {
716
717 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' => 'http://suika.fam.cx/~wakaba/archive/2004/dom/main#ensureXMLName', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => '$INPUT_PARAM_NAME';
718
719 ;
720 }
721 }
722
723
724 }
725
726 ;
727 }
728
729
730 {
731
732 local $Error::Depth = $Error::Depth + 1;
733
734 {
735
736
737
738 $self->
739 strict_error_checking
740 (
741 0
742 );
743 $r = $self->
744 create_attribute_ns
745 (
746 undef
747 , [
748 undef
749 , $name]);
750 $self->
751 strict_error_checking
752 ($strict);
753
754
755
756 }
757
758
759 ;}
760
761 ;
762
763
764 }
765 $r}
766 sub create_attribute_ns ($$$) {
767 my ($self, $namespaceURI, $qualifiedName) = @_;
768
769 {
770
771 if
772 (CORE::defined $namespaceURI and CORE::length $namespaceURI == 0) {
773 require Message::DOM::DOMMain;
774
775 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:1167522123:25685:fj3zF510';
776
777 ;
778
779 $namespaceURI = undef;
780 }
781
782
783 }
784 my $r;
785
786 {
787
788 my
789 ($prefix, $lname) = ref $qualifiedName eq 'ARRAY'
790 ? @$qualifiedName
791 : split /:/, $qualifiedName, 2;
792 ($prefix, $lname) = (
793 undef
794 , $prefix) unless defined $lname;
795
796 ## TODO: autoload
797 if ((defined $namespaceURI and $namespaceURI eq
798 'http://www.w3.org/XML/1998/namespace'
799 ) or
800 ($lname =~ /^xml:/)) {
801 require Message::DOM::XML;
802 }
803
804 if ($self->
805 strict_error_checking
806 ) {
807 my $version = $self->
808 xml_version
809 ;
810 $qualifiedName = defined $prefix ? $prefix.':'.$lname
811 : $lname;
812
813
814 {
815
816 if
817 (defined $version and $version eq '1.1') {
818 unless (
819 ($qualifiedName =~ /\A\p{InXMLNameStartChar11}\p{InXMLNameChar11}*\z/)
820 ) {
821
822 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' => 'http://suika.fam.cx/~wakaba/archive/2004/dom/main#ensureXMLQName', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => '$INPUT_NAME';
823
824 ;
825 }
826 unless (
827 ($qualifiedName =~ /\A\p{InXMLNCNameStartChar11}\p{InXMLNCNameChar11}*(?::\p{InXMLNCNameStartChar11}\p{InXMLNCNameChar11}*)?\z/)
828 ) {
829
830 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' => 'http://suika.fam.cx/~wakaba/archive/2004/dom/main#ensureXMLQName', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => '$INPUT_NAME';
831
832 ;
833 }
834 } else {
835 unless (
836 ($qualifiedName =~ /\A\p{InXML_NameStartChar10}\p{InXMLNameChar10}*\z/)
837 ) {
838
839 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' => 'http://suika.fam.cx/~wakaba/archive/2004/dom/main#ensureXMLQName', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => '$INPUT_NAME';
840
841 ;
842 }
843 unless (
844 ($qualifiedName =~ /\A\p{InXML_NCNameStartChar10}\p{InXMLNCNameChar10}*(?::\p{InXML_NCNameStartChar10}\p{InXMLNCNameChar10}*)?\z/)
845 ) {
846
847 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' => 'http://suika.fam.cx/~wakaba/archive/2004/dom/main#ensureXMLQName', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => '$INPUT_NAME';
848
849 ;
850 }
851 }
852
853
854 }
855
856 ;
857
858
859 {
860
861 if
862 (defined $prefix) {
863 if (not defined $namespaceURI) {
864
865 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' => 'http://suika.fam.cx/~wakaba/archive/2004/dom/main#checkXMLNamesQName';
866
867 ;
868 } elsif ($prefix eq 'xml' and $namespaceURI ne
869 'http://www.w3.org/XML/1998/namespace'
870 ) {
871
872 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' => 'http://suika.fam.cx/~wakaba/archive/2004/dom/main#checkXMLNamesQName';
873
874 ;
875 } elsif ($prefix eq 'xmlns' and $namespaceURI ne
876 'http://www.w3.org/2000/xmlns/'
877 ) {
878
879 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' => 'http://suika.fam.cx/~wakaba/archive/2004/dom/main#checkXMLNamesQName';
880
881 ;
882 } elsif ($namespaceURI eq
883 'http://www.w3.org/XML/1998/namespace' and
884 $prefix ne 'xml') {
885
886 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' => 'http://suika.fam.cx/~wakaba/archive/2004/dom/main#checkXMLNamesQName';
887
888 ;
889 } elsif ($namespaceURI eq
890 'http://www.w3.org/2000/xmlns/' and
891 $prefix ne 'xmlns') {
892
893 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' => 'http://suika.fam.cx/~wakaba/archive/2004/dom/main#checkXMLNamesQName';
894
895 ;
896 }
897 } else { ## No prefix
898 if (not defined $namespaceURI) {
899 #
900 } elsif ($namespaceURI eq
901 'http://www.w3.org/2000/xmlns/' and
902 $lname ne 'xmlns') {
903
904 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' => 'http://suika.fam.cx/~wakaba/archive/2004/dom/main#checkXMLNamesQName';
905
906 ;
907 }
908 }
909
910
911 }
912
913 ;
914 }
915
916 $r = bless \{
917
918 'od'
919 => $self,
920
921 'child'
922 => [],
923
924 'specified'
925 => 1,
926 },
927 'Message::DOM::Element::ManakaiDOMAttr'
928 ;
929 Scalar::Util::weaken ($$r->{
930 'od'
931 });
932
933
934 {
935
936 if
937 (defined $namespaceURI) {
938 if (ref $namespaceURI eq 'SCALAR') {
939 $$r->{'ns'} = $namespaceURI;
940 } elsif (defined $Message::Util::ManakaiStringRef::Value{$namespaceURI}) {
941 $$r->{'ns'} = $Message::Util::ManakaiStringRef::Value{$namespaceURI};
942 } else {
943 require Scalar::Util;
944 $$r->{'ns'} = $Message::Util::ManakaiStringRef::Value{$namespaceURI} = \($namespaceURI);
945 Scalar::Util::weaken ($Message::Util::ManakaiStringRef::Value{$namespaceURI});
946 }
947 } else {
948 CORE::delete $$r->{'ns'};
949 }
950
951
952 }
953
954 ;
955
956
957 {
958
959 if
960 (defined $prefix) {
961 if (ref $prefix eq 'SCALAR') {
962 $$r->{'pfx'} = $prefix;
963 } elsif (defined $Message::Util::ManakaiStringRef::Value{$prefix}) {
964 $$r->{'pfx'} = $Message::Util::ManakaiStringRef::Value{$prefix};
965 } else {
966 require Scalar::Util;
967 $$r->{'pfx'} = $Message::Util::ManakaiStringRef::Value{$prefix} = \($prefix);
968 Scalar::Util::weaken ($Message::Util::ManakaiStringRef::Value{$prefix});
969 }
970 } else {
971 CORE::delete $$r->{'pfx'};
972 }
973
974
975 }
976
977 ;
978
979
980 {
981
982 if
983 (defined $lname) {
984 if (ref $lname eq 'SCALAR') {
985 $$r->{'ln'} = $lname;
986 } elsif (defined $Message::Util::ManakaiStringRef::Value{$lname}) {
987 $$r->{'ln'} = $Message::Util::ManakaiStringRef::Value{$lname};
988 } else {
989 require Scalar::Util;
990 $$r->{'ln'} = $Message::Util::ManakaiStringRef::Value{$lname} = \($lname);
991 Scalar::Util::weaken ($Message::Util::ManakaiStringRef::Value{$lname});
992 }
993 } else {
994 CORE::delete $$r->{'ln'};
995 }
996
997
998 }
999
1000 ;
1001
1002
1003 ## Attribute type information
1004 if ((defined $namespaceURI and $namespaceURI eq
1005 'http://www.w3.org/XML/1998/namespace' and
1006
1007 $lname eq 'id') or
1008 (not defined $namespaceURI and $lname eq 'xml:id')) {
1009
1010
1011 {
1012
1013 local $Error::Depth = $Error::Depth + 1;
1014
1015 {
1016
1017
1018 if
1019 ($self->
1020 dom_config
1021
1022 ->
1023 get_parameter
1024
1025 (
1026 'http://suika.fam.cx/www/2006/dom-config/xml-id'
1027 )) {
1028 $r->
1029 manakai_attribute_type
1030 (
1031 2
1032 );
1033 }
1034
1035
1036
1037 }
1038
1039
1040 ;}
1041
1042 ;
1043 }
1044
1045
1046 }
1047 $r}
1048 $Message::DOM::DOMFeature::ClassInfo->{q<Message::DOM::Element::ManakaiDOMDocumentElement>}->{has_feature} = {};
1049 $Message::DOM::ClassPoint{q<Message::DOM::Element::ManakaiDOMDocumentElement>} = 0;
1050 package Message::DOM::IF::Element;
1051 our $VERSION = 20061231.0208;
1052 package Message::DOM::Element::ManakaiDOMElement;
1053 our $VERSION = 20061231.0208;
1054 push our @ISA, 'Message::DOM::TreeCore::ManakaiDOMNode',
1055 'Message::DOM::IF::Element',
1056 'Message::DOM::IF::Node';
1057 use Char::Class::XML 'InXMLNCNameChar10',
1058 'InXMLNCNameChar11',
1059 'InXMLNCNameStartChar11',
1060 'InXMLNameChar10',
1061 'InXMLNameChar11',
1062 'InXMLNameStartChar11',
1063 'InXML_NCNameStartChar10',
1064 'InXML_NameStartChar10';
1065 sub node_type ($;$) {
1066 if (@_ == 1) {my ($self) = @_;
1067 my $r;
1068 $r = 1;
1069 $r;
1070 } else {my ($self) = @_;
1071 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';
1072 }
1073 }
1074 sub prefix ($;$) {
1075 if (@_ == 1) {my ($self) = @_;
1076 my $r = '';
1077
1078 {
1079
1080 my
1081 $v = $$self->{
1082 'pfx'
1083 };
1084 $r = defined $v ? $$v : undef;
1085
1086
1087 }
1088 $r;
1089 } else {my ($self, $given) = @_;
1090
1091 {
1092
1093 my
1094 $od = $self->
1095 owner_document
1096 ;
1097 if ($od->
1098 strict_error_checking
1099 ) {
1100
1101
1102 {
1103
1104 if
1105 ($self->
1106 manakai_read_only
1107 ) {
1108
1109 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' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/NodeReadOnlyError';
1110
1111 ;
1112 }
1113
1114
1115 }
1116
1117 ;
1118 my $nsuri = $$self->{
1119 'ns'
1120 };
1121 if (not defined $nsuri) {
1122
1123 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';
1124
1125 ;
1126 } elsif ($$nsuri ne
1127 'http://www.w3.org/XML/1998/namespace' and
1128
1129 defined $given and $given eq 'xml') {
1130
1131 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';
1132
1133 ;
1134 }
1135 my $version = $od->
1136 xml_version
1137 ;
1138
1139
1140 {
1141
1142 if
1143 (defined $given and $given eq '') {
1144 require Message::DOM::DOMMain;
1145
1146 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' => 'http://suika.fam.cx/~wakaba/archive/2004/dom/main#ensureNamespacePrefix';
1147
1148 ;
1149 undef $given;
1150 }
1151 if (defined $given) {
1152 if (($version eq '1.0' and
1153 not
1154 ($given =~ /\A\p{InXML_NameStartChar10}\p{InXMLNameChar10}*\z/)
1155 ) or
1156 ($version eq '1.1' and
1157 not
1158 ($given =~ /\A\p{InXMLNameStartChar11}\p{InXMLNameChar11}*\z/)
1159 )) {
1160
1161 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' => 'http://suika.fam.cx/~wakaba/archive/2004/dom/main#ensureNamespacePrefix', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => '$INPUT_PARAM_NAME';
1162
1163 ;
1164 } elsif (index ($given, ':') > -1) {
1165
1166 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' => 'http://suika.fam.cx/~wakaba/archive/2004/dom/main#ensureNamespacePrefix', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => '$INPUT_PARAM_NAME';
1167
1168 ;
1169 }
1170 } # has prefix
1171
1172
1173 }
1174
1175 ;
1176 } # strict
1177 if (defined $given) {
1178 $$self->{
1179 'pfx'
1180 } = \$given;
1181 } else {
1182 CORE::delete $$self->{
1183 'pfx'
1184 };
1185 }
1186
1187
1188 }
1189 }
1190 }
1191 sub append_child ($$) {
1192 my ($self, $newChild) = @_;
1193 my $r;
1194
1195 {
1196
1197 my
1198 $self_od = $self->
1199 owner_document
1200 ;
1201 if ($self_od->
1202 strict_error_checking
1203 ) {
1204 my $anode = $self;
1205 while (defined $anode) {
1206 if ($anode eq $newChild) {
1207
1208 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;
1209
1210 ;
1211 }
1212 $anode = $anode->
1213 parent_node
1214 ;
1215 }
1216 }
1217 my $child_od = $newChild->
1218 owner_document
1219 ;
1220 my $child_nt = $newChild->
1221 node_type
1222 ;
1223
1224
1225 {
1226
1227
1228 {
1229
1230 local $Error::Depth = $Error::Depth + 1;
1231
1232 {
1233
1234
1235 my
1236 $strict = $self_od->
1237 strict_error_checking
1238 ;
1239
1240 ## -- Node Type check
1241 my @new_child;
1242 if ({
1243 3 => 1,
1244 5 => 1,
1245 1 => 1,
1246 4 => 1,
1247 7 => 1,
1248 8 => 1,
1249 }->{$child_nt}) {
1250 push @new_child, $newChild;
1251 } elsif ($child_nt ==
1252 11
1253 ) {
1254 for my $cn (@{$newChild->
1255 child_nodes
1256 }) {
1257 unless ({
1258 3 => 1,
1259 5 => 1,
1260 1 => 1,
1261 4 => 1,
1262 7 => 1,
1263 8 => 1,
1264 }->{$cn->
1265 node_type
1266 }) {
1267
1268
1269 {
1270
1271 local $Error::Depth = $Error::Depth - 1;
1272
1273 {
1274
1275 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' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/appendChildImpl1', '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;
1276
1277
1278 }
1279
1280
1281 ;}
1282
1283 ;
1284 }
1285 push @new_child, $cn;
1286 }
1287 } else {
1288
1289
1290 {
1291
1292 local $Error::Depth = $Error::Depth - 1;
1293
1294 {
1295
1296 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' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/appendChildImpl1', '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;
1297
1298
1299 }
1300
1301
1302 ;}
1303
1304 ;
1305 }
1306
1307 my $nc_parent = @new_child ? $new_child[0]->
1308 parent_node
1309 :
1310
1311 undef
1312 ;
1313 if ($strict) {
1314 ## -- Wrong-document check
1315 unless ($self_od eq $child_od) {
1316
1317
1318 {
1319
1320 local $Error::Depth = $Error::Depth - 1;
1321
1322 {
1323
1324 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' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/appendChildImpl1', '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;
1325
1326
1327 }
1328
1329
1330 ;}
1331
1332 ;
1333 }
1334
1335 ## -- Read-onlyness check
1336 if ($self->
1337 manakai_read_only
1338 ) {
1339
1340
1341 {
1342
1343 local $Error::Depth = $Error::Depth - 1;
1344
1345 {
1346
1347 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' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/appendChildImpl1';
1348
1349
1350 }
1351
1352
1353 ;}
1354
1355 ;
1356 }
1357 if (@new_child) {
1358 if ($nc_parent and
1359 $nc_parent->
1360 manakai_read_only
1361 ) {
1362
1363
1364 {
1365
1366 local $Error::Depth = $Error::Depth - 1;
1367
1368 {
1369
1370 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' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/appendChildImpl1';
1371
1372
1373 }
1374
1375
1376 ;}
1377
1378 ;
1379 }
1380 }
1381 }
1382
1383 ## -- Insert at...
1384 my $index = -1; # last
1385
1386
1387 ; # FOR !tc:ForAppendChild
1388
1389 ## -- Removes from parent
1390 if ($nc_parent) {
1391 if ($child_nt ==
1392 11
1393 ) {
1394 $$newChild->{
1395 'child'
1396 } = [];
1397 } else {
1398 my $v = $$nc_parent->{
1399 'child'
1400 };
1401 RP: for my $i (0..$#$v) {
1402 if ($v->[$i] eq $new_child[0]) {
1403 splice @$v, $i, 1, ();
1404 last RP;
1405 }
1406 } # RP
1407 }
1408 }
1409
1410 ## -- Rewrite the |parentNode| properties
1411 for my $nc (@new_child) {
1412 $$nc->{
1413 'parent'
1414 } = $self;
1415 Scalar::Util::weaken ($$nc->{
1416 'parent'
1417 });
1418 }
1419
1420 my $children = $$self->{
1421 'child'
1422 };
1423
1424
1425
1426 {
1427
1428
1429 ## -- Adds to children list
1430 push @$children, @new_child;
1431 $r = $newChild;
1432
1433
1434
1435 }
1436
1437 ;
1438
1439
1440
1441 ;
1442
1443
1444
1445 ;
1446
1447
1448
1449 }
1450
1451
1452 ;}
1453
1454 ;
1455
1456
1457 }
1458
1459 ;
1460
1461
1462 }
1463 $r}
1464 sub insert_before ($$;$) {
1465 my ($self, $newChild, $refChild) = @_;
1466 my $r;
1467
1468 {
1469
1470 my
1471 $self_od = $self->
1472 owner_document
1473 ;
1474 if ($self_od->
1475 strict_error_checking
1476 ) {
1477 my $anode = $self;
1478 while (defined $anode) {
1479 if ($anode eq $newChild) {
1480
1481 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;
1482
1483 ;
1484 }
1485 $anode = $anode->
1486 parent_node
1487 ;
1488 }
1489 }
1490 my $child_od = $newChild->
1491 owner_document
1492 ;
1493 my $child_nt = $newChild->
1494 node_type
1495 ;
1496
1497
1498 {
1499
1500
1501 {
1502
1503 local $Error::Depth = $Error::Depth + 1;
1504
1505 {
1506
1507
1508 my
1509 $strict = $self_od->
1510 strict_error_checking
1511 ;
1512
1513 ## -- Node Type check
1514 my @new_child;
1515 if ({
1516 3 => 1,
1517 5 => 1,
1518 1 => 1,
1519 4 => 1,
1520 7 => 1,
1521 8 => 1,
1522 }->{$child_nt}) {
1523 push @new_child, $newChild;
1524 } elsif ($child_nt ==
1525 11
1526 ) {
1527 for my $cn (@{$newChild->
1528 child_nodes
1529 }) {
1530 unless ({
1531 3 => 1,
1532 5 => 1,
1533 1 => 1,
1534 4 => 1,
1535 7 => 1,
1536 8 => 1,
1537 }->{$cn->
1538 node_type
1539 }) {
1540
1541
1542 {
1543
1544 local $Error::Depth = $Error::Depth - 1;
1545
1546 {
1547
1548 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' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/insertBeforeImpl1', '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;
1549
1550
1551 }
1552
1553
1554 ;}
1555
1556 ;
1557 }
1558 push @new_child, $cn;
1559 }
1560 } else {
1561
1562
1563 {
1564
1565 local $Error::Depth = $Error::Depth - 1;
1566
1567 {
1568
1569 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' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/insertBeforeImpl1', '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;
1570
1571
1572 }
1573
1574
1575 ;}
1576
1577 ;
1578 }
1579
1580 my $nc_parent = @new_child ? $new_child[0]->
1581 parent_node
1582 :
1583
1584 undef
1585 ;
1586 if ($strict) {
1587 ## -- Wrong-document check
1588 unless ($self_od eq $child_od) {
1589
1590
1591 {
1592
1593 local $Error::Depth = $Error::Depth - 1;
1594
1595 {
1596
1597 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' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/insertBeforeImpl1', '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;
1598
1599
1600 }
1601
1602
1603 ;}
1604
1605 ;
1606 }
1607
1608 ## -- Read-onlyness check
1609 if ($self->
1610 manakai_read_only
1611 ) {
1612
1613
1614 {
1615
1616 local $Error::Depth = $Error::Depth - 1;
1617
1618 {
1619
1620 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' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/insertBeforeImpl1';
1621
1622
1623 }
1624
1625
1626 ;}
1627
1628 ;
1629 }
1630 if (@new_child) {
1631 if ($nc_parent and
1632 $nc_parent->
1633 manakai_read_only
1634 ) {
1635
1636
1637 {
1638
1639 local $Error::Depth = $Error::Depth - 1;
1640
1641 {
1642
1643 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' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/insertBeforeImpl1';
1644
1645
1646 }
1647
1648
1649 ;}
1650
1651 ;
1652 }
1653 }
1654 }
1655
1656 ## -- Insert at...
1657 my $index = -1; # last
1658
1659
1660 {
1661
1662
1663 # tc:ForAppendChild & tc:ForReplaceChild
1664 if (defined $refChild) {
1665 if ($refChild eq $newChild) {
1666
1667
1668 {
1669
1670
1671 {
1672
1673 local $Error::Depth = $Error::Depth - 1;
1674
1675 {
1676
1677 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' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/insertBeforeImpl1';
1678
1679
1680 }
1681
1682
1683 ;}
1684
1685 ;
1686
1687
1688
1689 }
1690
1691 ;
1692
1693
1694 ;
1695 }
1696
1697 my $cns = $self->
1698 child_nodes
1699 ;
1700 my $cnsl = @$cns;
1701 C: {
1702 $index = 0;
1703 for my $i (0..($cnsl-1)) {
1704 my $cn = $cns->[$i];
1705 if ($cn eq $refChild) {
1706 $index += $i;
1707 last C;
1708 } elsif ($cn eq $newChild) {
1709 $index = -1; # offset
1710 }
1711 }
1712
1713
1714 {
1715
1716
1717 {
1718
1719 local $Error::Depth = $Error::Depth - 1;
1720
1721 {
1722
1723 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' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/insertBeforeImpl1', '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;
1724
1725
1726 }
1727
1728
1729 ;}
1730
1731 ;
1732
1733
1734
1735 }
1736
1737 ;
1738
1739
1740 ;
1741 } # C
1742 } else { # |oldChild| is not defined
1743
1744
1745 ;
1746 }
1747
1748
1749
1750 }
1751
1752 ; # FOR !tc:ForAppendChild
1753
1754 ## -- Removes from parent
1755 if ($nc_parent) {
1756 if ($child_nt ==
1757 11
1758 ) {
1759 $$newChild->{
1760 'child'
1761 } = [];
1762 } else {
1763 my $v = $$nc_parent->{
1764 'child'
1765 };
1766 RP: for my $i (0..$#$v) {
1767 if ($v->[$i] eq $new_child[0]) {
1768 splice @$v, $i, 1, ();
1769 last RP;
1770 }
1771 } # RP
1772 }
1773 }
1774
1775 ## -- Rewrite the |parentNode| properties
1776 for my $nc (@new_child) {
1777 $$nc->{
1778 'parent'
1779 } = $self;
1780 Scalar::Util::weaken ($$nc->{
1781 'parent'
1782 });
1783 }
1784
1785 my $children = $$self->{
1786 'child'
1787 };
1788
1789
1790
1791 ;
1792
1793
1794
1795 {
1796
1797
1798 ## -- Adds to children list
1799 if ($index == -1) {
1800 push @$children, @new_child;
1801 } else {
1802 splice @$children, $index, 0, @new_child;
1803 }
1804 $r = $newChild;
1805
1806
1807
1808 }
1809
1810 ;
1811
1812
1813
1814 ;
1815
1816
1817
1818 }
1819
1820
1821 ;}
1822
1823 ;
1824
1825
1826 }
1827
1828 ;
1829
1830
1831 }
1832 $r}
1833 sub replace_child ($$$) {
1834 my ($self, $newChild, $oldChild) = @_;
1835 my $r;
1836
1837 {
1838
1839 my
1840 $self_od = $self->
1841 owner_document
1842 ;
1843 if ($self_od->
1844 strict_error_checking
1845 ) {
1846 my $anode = $self;
1847 while (defined $anode) {
1848 if ($anode eq $newChild) {
1849
1850 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;
1851
1852 ;
1853 }
1854 $anode = $anode->
1855 parent_node
1856 ;
1857 }
1858 }
1859 my $child_od = $newChild->
1860 owner_document
1861 ;
1862 my $child_nt = $newChild->
1863 node_type
1864 ;
1865
1866
1867 {
1868
1869
1870 {
1871
1872 local $Error::Depth = $Error::Depth + 1;
1873
1874 {
1875
1876
1877 my
1878 $strict = $self_od->
1879 strict_error_checking
1880 ;
1881
1882 ## -- Node Type check
1883 my @new_child;
1884 if ({
1885 3 => 1,
1886 5 => 1,
1887 1 => 1,
1888 4 => 1,
1889 7 => 1,
1890 8 => 1,
1891 }->{$child_nt}) {
1892 push @new_child, $newChild;
1893 } elsif ($child_nt ==
1894 11
1895 ) {
1896 for my $cn (@{$newChild->
1897 child_nodes
1898 }) {
1899 unless ({
1900 3 => 1,
1901 5 => 1,
1902 1 => 1,
1903 4 => 1,
1904 7 => 1,
1905 8 => 1,
1906 }->{$cn->
1907 node_type
1908 }) {
1909
1910
1911 {
1912
1913 local $Error::Depth = $Error::Depth - 1;
1914
1915 {
1916
1917 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' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/replaceChildImpl1', '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;
1918
1919
1920 }
1921
1922
1923 ;}
1924
1925 ;
1926 }
1927 push @new_child, $cn;
1928 }
1929 } else {
1930
1931
1932 {
1933
1934 local $Error::Depth = $Error::Depth - 1;
1935
1936 {
1937
1938 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' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/replaceChildImpl1', '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;
1939
1940
1941 }
1942
1943
1944 ;}
1945
1946 ;
1947 }
1948
1949 my $nc_parent = @new_child ? $new_child[0]->
1950 parent_node
1951 :
1952
1953 undef
1954 ;
1955 if ($strict) {
1956 ## -- Wrong-document check
1957 unless ($self_od eq $child_od) {
1958
1959
1960 {
1961
1962 local $Error::Depth = $Error::Depth - 1;
1963
1964 {
1965
1966 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' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/replaceChildImpl1', '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;
1967
1968
1969 }
1970
1971
1972 ;}
1973
1974 ;
1975 }
1976
1977 ## -- Read-onlyness check
1978 if ($self->
1979 manakai_read_only
1980 ) {
1981
1982
1983 {
1984
1985 local $Error::Depth = $Error::Depth - 1;
1986
1987 {
1988
1989 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' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/replaceChildImpl1';
1990
1991
1992 }
1993
1994
1995 ;}
1996
1997 ;
1998 }
1999 if (@new_child) {
2000 if ($nc_parent and
2001 $nc_parent->
2002 manakai_read_only
2003 ) {
2004
2005
2006 {
2007
2008 local $Error::Depth = $Error::Depth - 1;
2009
2010 {
2011
2012 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' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/replaceChildImpl1';
2013
2014
2015 }
2016
2017
2018 ;}
2019
2020 ;
2021 }
2022 }
2023 }
2024
2025 ## -- Insert at...
2026 my $index = -1; # last
2027
2028
2029 {
2030
2031
2032 # tc:ForAppendChild & tc:ForReplaceChild
2033 if (defined $oldChild) {
2034 if ($oldChild eq $newChild) {
2035
2036
2037 ;
2038
2039
2040 {
2041
2042
2043 {
2044
2045 local $Error::Depth = $Error::Depth - 1;
2046
2047 {
2048
2049 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' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/replaceChildImpl1';
2050
2051
2052 }
2053
2054
2055 ;}
2056
2057 ;
2058
2059
2060
2061 }
2062
2063 ;
2064 }
2065
2066 my $cns = $self->
2067 child_nodes
2068 ;
2069 my $cnsl = @$cns;
2070 C: {
2071 $index = 0;
2072 for my $i (0..($cnsl-1)) {
2073 my $cn = $cns->[$i];
2074 if ($cn eq $oldChild) {
2075 $index += $i;
2076 last C;
2077 } elsif ($cn eq $newChild) {
2078 $index = -1; # offset
2079 }
2080 }
2081
2082
2083 ;
2084
2085
2086 {
2087
2088
2089 {
2090
2091 local $Error::Depth = $Error::Depth - 1;
2092
2093 {
2094
2095 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' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/replaceChildImpl1', '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;
2096
2097
2098 }
2099
2100
2101 ;}
2102
2103 ;
2104
2105
2106
2107 }
2108
2109 ;
2110 } # C
2111 } else { # |oldChild| is not defined
2112
2113
2114 {
2115
2116
2117 {
2118
2119 local $Error::Depth = $Error::Depth - 1;
2120
2121 {
2122
2123 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' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/replaceChildImpl1', '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;
2124
2125
2126 }
2127
2128
2129 ;}
2130
2131 ;
2132
2133
2134
2135 }
2136
2137 ;
2138 }
2139
2140
2141
2142 }
2143
2144 ; # FOR !tc:ForAppendChild
2145
2146 ## -- Removes from parent
2147 if ($nc_parent) {
2148 if ($child_nt ==
2149 11
2150 ) {
2151 $$newChild->{
2152 'child'
2153 } = [];
2154 } else {
2155 my $v = $$nc_parent->{
2156 'child'
2157 };
2158 RP: for my $i (0..$#$v) {
2159 if ($v->[$i] eq $new_child[0]) {
2160 splice @$v, $i, 1, ();
2161 last RP;
2162 }
2163 } # RP
2164 }
2165 }
2166
2167 ## -- Rewrite the |parentNode| properties
2168 for my $nc (@new_child) {
2169 $$nc->{
2170 'parent'
2171 } = $self;
2172 Scalar::Util::weaken ($$nc->{
2173 'parent'
2174 });
2175 }
2176
2177 my $children = $$self->{
2178 'child'
2179 };
2180
2181
2182
2183 ;
2184
2185
2186
2187 ;
2188
2189
2190
2191 {
2192
2193
2194 ## -- Replaces the node
2195 splice @$children, $index, 1, @new_child;
2196 CORE::delete $$oldChild->{
2197 'parent'
2198 };
2199 $r = $oldChild;
2200
2201
2202
2203 }
2204
2205 ;
2206
2207
2208
2209 }
2210
2211
2212 ;}
2213
2214 ;
2215
2216
2217 }
2218
2219 ;
2220
2221
2222 }
2223 $r}
2224 sub attributes ($;$) {
2225 if (@_ == 1) {my ($self) = @_;
2226 my $r;
2227
2228 {
2229
2230
2231 {
2232
2233
2234 $r = bless \\($self),
2235 'Message::DOM::TreeCore::ManakaiDOMAttrMap'
2236 ;
2237 $$self->{
2238 'hpos'
2239 } ||= 0;
2240
2241
2242 }
2243
2244 ;
2245
2246
2247 }
2248 $r;
2249 } else {my ($self) = @_;
2250 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';
2251 }
2252 }
2253 sub node_name ($;$) {
2254 if (@_ == 1) {my ($self) = @_;
2255 my $r = '';
2256
2257 {
2258
2259 my
2260 $prefix = $$self->{
2261 'pfx'
2262 };
2263 my $lname = $$self->{
2264 'ln'
2265 };
2266 $r = defined $prefix ? $$prefix.':'.$$lname : $$lname;
2267
2268
2269 }
2270 $r;
2271 } else {my ($self) = @_;
2272 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';
2273 }
2274 }
2275 sub tag_name ($;$) {
2276 if (@_ == 1) {my ($self) = @_;
2277 my $r = '';
2278
2279 {
2280
2281 my
2282 $prefix = $$self->{
2283 'pfx'
2284 };
2285 my $lname = $$self->{
2286 'ln'
2287 };
2288 $r = defined $prefix ? $$prefix.':'.$$lname : $$lname;
2289
2290
2291 }
2292 $r;
2293 } else {my ($self) = @_;
2294 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';
2295 }
2296 }
2297 sub manakai_append_text ($$) {
2298 my ($self, $string) = @_;
2299 my $r;
2300
2301 {
2302
2303
2304 {
2305
2306 local $Error::Depth = $Error::Depth + 1;
2307
2308 {
2309
2310
2311 my
2312 $lc = $self->
2313 last_child
2314 ;
2315 if (defined $lc and
2316 $lc->
2317 node_type
2318 ==
2319 3
2320 ) {
2321 $lc->
2322 manakai_append_text
2323
2324 (ref $string eq 'SCALAR' ? $string : \$string);
2325 } else {
2326 my $text = $self->
2327 owner_document
2328
2329 ->
2330 create_text_node
2331
2332 (ref $string eq 'SCALAR' ? $$string : $string);
2333 $self->
2334 append_child
2335 ($text);
2336 }
2337 $r = $self;
2338
2339
2340
2341 }
2342
2343
2344 ;}
2345
2346 ;
2347
2348
2349 }
2350 $r}
2351 sub get_feature ($$$) {
2352 my ($self, $feature, $version) = @_;
2353
2354 {
2355
2356
2357 $feature = lc $feature;
2358
2359
2360 }
2361
2362 {
2363
2364
2365 $version = '' unless defined $version;
2366
2367
2368 }
2369 my $r;
2370
2371 {
2372
2373
2374 $feature =~ s/^\+//;
2375
2376
2377 {
2378
2379 if
2380 ($Message::Util::AutoLoad::Registry::Feature->{$feature}->{$version}) {
2381 $r = $self;
2382 }
2383
2384
2385 }
2386
2387 ;
2388 unless (defined $r) {
2389
2390
2391 {
2392
2393 local $Error::Depth = $Error::Depth + 1;
2394
2395 {
2396
2397
2398
2399 $r = $self->SUPER::get_feature ($feature, $version);
2400
2401
2402
2403 }
2404
2405
2406 ;}
2407
2408 ;
2409 }
2410
2411
2412 }
2413 $r}
2414 sub base_uri ($;$) {
2415 if (@_ == 1) {my ($self) = @_;
2416 my $r = '';
2417
2418 {
2419
2420
2421 $r = $$self->{
2422 'buri'
2423 };
2424 unless (defined $r) {
2425
2426
2427 {
2428
2429 local $Error::Depth = $Error::Depth + 1;
2430
2431 {
2432
2433
2434 my
2435 $xb = $self->
2436 get_attribute_node_ns
2437
2438 (
2439 'http://www.w3.org/XML/1998/namespace'
2440 , 'base');
2441 unless (defined $xb) {
2442 $xb = $self->
2443 get_attribute_node_ns
2444
2445 (
2446 undef
2447 , 'xml:base');
2448 }
2449 if ($xb) {
2450 $r = $xb->
2451 value
2452 ;
2453 if (
2454 ($r !~ m!\A[^:/?#]+:!)
2455 ) {
2456 my $xbbase = $xb->
2457 base_uri
2458 ;
2459 $r = $self->
2460 owner_document
2461
2462 ->
2463 implementation
2464
2465 ->
2466 create_uri_reference
2467
2468 ($r)
2469 ->
2470 get_absolute_reference
2471
2472 ($xbbase)
2473 ->
2474 uri_reference
2475 if
2476 defined $xbbase;
2477 }
2478 } else {
2479 my $pe = $self->
2480 parent_node
2481 ;
2482 W: {
2483 while (defined $pe) {
2484 my $nt = $pe->
2485 node_type
2486 ;
2487 if ($nt ==
2488 1 or
2489
2490 $nt ==
2491 9 or
2492
2493 $nt ==
2494 11 or
2495
2496 $nt ==
2497 6
2498 ) {
2499 $r = $pe->
2500 base_uri
2501 ;
2502 last W;
2503 } elsif ($nt ==
2504 5
2505 ) {
2506 if ($pe->
2507 manakai_external
2508 ) {
2509 $r = $pe->
2510 manakai_entity_base_uri
2511 ;
2512 last W;
2513 }
2514 }
2515 $pe = $pe->
2516 parent_node
2517 ;
2518 }
2519 if ($pe) {
2520 $r = $pe->
2521 base_uri
2522 ;
2523 } else {
2524 $r = $self->
2525 owner_document
2526 ->
2527 base_uri
2528 ;
2529 }
2530 } # W
2531 }
2532
2533
2534
2535 }
2536
2537
2538 ;}
2539
2540 ;
2541 }
2542
2543
2544 }
2545 $r;
2546 } else {my ($self) = @_;
2547 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';
2548 }
2549 }
2550 sub get_attribute ($$) {
2551 my ($self, $name) = @_;
2552 my $r = '';
2553
2554 {
2555
2556 my
2557 $node;
2558
2559
2560 {
2561
2562 my
2563 $__attr = ${$self}->{
2564 'attr'
2565 };
2566
2567 ## Note that we no longer support DOM Level 1 nodes.
2568
2569 ## If an attribute's qualified name is equal to
2570 ## the requested name, then the node is the answer.
2571
2572 ## Note that if there is a namespace ill-formed attribute,
2573 ## the result is not the expected one. For example,
2574 ## if an |xmlns| attribute in the |http://www.w3.org/2000/xmlns/|
2575 ## namespace has non-NULL |prefix|, a request to get |xmlns|
2576 ## attribute will not return that node.
2577
2578 ## |sort|ing is required so that every |getAttribute|, |setAttribute|,
2579 ## |hasAttribute|, |removeAttribute|, or any other namespace unaware
2580 ## methods operates on the same node even if there is
2581 ## multiple nodes with the same qualified name.
2582
2583 NS: for my $__ns (sort {$a cmp $b} keys %$__attr) {
2584 for my $__ln (sort {$a cmp $b} keys %{$__attr->{$__ns}}) {
2585 my $__node = $__attr->{$__ns}->{$__ln};
2586 if ($__node->
2587 node_name eq
2588 $name) {
2589
2590
2591 {
2592
2593
2594 $node = $__node;
2595
2596
2597
2598 }
2599
2600 ;
2601
2602
2603 ;
2604 last NS;
2605 }
2606 } # ln
2607 } # NS
2608
2609
2610 }
2611
2612 ;
2613 if (defined $node) {
2614 $r = $node->
2615 value
2616 ;
2617 } else {
2618 $r =
2619 undef
2620 ;
2621 }
2622
2623
2624 }
2625 $r}
2626 sub get_attribute_ns ($$$) {
2627 my ($self, $namespaceURI, $localName) = @_;
2628
2629 {
2630
2631 if
2632 (CORE::defined $namespaceURI and CORE::length $namespaceURI == 0) {
2633 require Message::DOM::DOMMain;
2634
2635 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:1167522123:25685:fj3zF510';
2636
2637 ;
2638
2639 $namespaceURI = undef;
2640 }
2641
2642
2643 }
2644 my $r = '';
2645
2646 {
2647
2648 my
2649 $node;
2650
2651
2652 {
2653
2654 my
2655 $__attrs = ${$self}->{
2656 'attr'
2657 };
2658 if (defined $__attrs->{defined $namespaceURI ? $namespaceURI : ''}
2659 ->{$localName}) {
2660 $node = $__attrs->{defined $namespaceURI ? $namespaceURI : ''}
2661 ->{$localName};
2662 }
2663
2664
2665 }
2666
2667 ;
2668 if (defined $node) {
2669 $r = $node->
2670 value
2671 ;
2672 } else {
2673 $r =
2674 undef
2675 ;
2676 }
2677
2678
2679 }
2680 $r}
2681 sub get_attribute_node ($$) {
2682 my ($self, $name) = @_;
2683 my $r;
2684
2685 {
2686
2687
2688 {
2689
2690 my
2691 $__attr = ${$self}->{
2692 'attr'
2693 };
2694
2695 ## Note that we no longer support DOM Level 1 nodes.
2696
2697 ## If an attribute's qualified name is equal to
2698 ## the requested name, then the node is the answer.
2699
2700 ## Note that if there is a namespace ill-formed attribute,
2701 ## the result is not the expected one. For example,
2702 ## if an |xmlns| attribute in the |http://www.w3.org/2000/xmlns/|
2703 ## namespace has non-NULL |prefix|, a request to get |xmlns|
2704 ## attribute will not return that node.
2705
2706 ## |sort|ing is required so that every |getAttribute|, |setAttribute|,
2707 ## |hasAttribute|, |removeAttribute|, or any other namespace unaware
2708 ## methods operates on the same node even if there is
2709 ## multiple nodes with the same qualified name.
2710
2711 NS: for my $__ns (sort {$a cmp $b} keys %$__attr) {
2712 for my $__ln (sort {$a cmp $b} keys %{$__attr->{$__ns}}) {
2713 my $__node = $__attr->{$__ns}->{$__ln};
2714 if ($__node->
2715 node_name eq
2716 $name) {
2717
2718
2719 {
2720
2721
2722 $r = $__node;
2723
2724
2725
2726 }
2727
2728 ;
2729
2730
2731 ;
2732 last NS;
2733 }
2734 } # ln
2735 } # NS
2736
2737
2738 }
2739
2740 ;
2741
2742
2743 }
2744 $r}
2745 sub get_attribute_node_ns ($$$) {
2746 my ($self, $namespaceURI, $localName) = @_;
2747
2748 {
2749
2750 if
2751 (CORE::defined $namespaceURI and CORE::length $namespaceURI == 0) {
2752 require Message::DOM::DOMMain;
2753
2754 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:1167522123:25685:fj3zF510';
2755
2756 ;
2757
2758 $namespaceURI = undef;
2759 }
2760
2761
2762 }
2763 my $r;
2764
2765 {
2766
2767
2768 {
2769
2770 my
2771 $__attrs = ${$self}->{
2772 'attr'
2773 };
2774 if (defined $__attrs->{defined $namespaceURI ? $namespaceURI : ''}
2775 ->{$localName}) {
2776 $r = $__attrs->{defined $namespaceURI ? $namespaceURI : ''}
2777 ->{$localName};
2778 }
2779
2780
2781 }
2782
2783 ;
2784
2785
2786 }
2787 $r}
2788 sub has_attribute ($$) {
2789 my ($self, $name) = @_;
2790 my $r = 0;
2791
2792 {
2793
2794 my
2795 $node;
2796
2797
2798 {
2799
2800 my
2801 $__attr = ${$self}->{
2802 'attr'
2803 };
2804
2805 ## Note that we no longer support DOM Level 1 nodes.
2806
2807 ## If an attribute's qualified name is equal to
2808 ## the requested name, then the node is the answer.
2809
2810 ## Note that if there is a namespace ill-formed attribute,
2811 ## the result is not the expected one. For example,
2812 ## if an |xmlns| attribute in the |http://www.w3.org/2000/xmlns/|
2813 ## namespace has non-NULL |prefix|, a request to get |xmlns|
2814 ## attribute will not return that node.
2815
2816 ## |sort|ing is required so that every |getAttribute|, |setAttribute|,
2817 ## |hasAttribute|, |removeAttribute|, or any other namespace unaware
2818 ## methods operates on the same node even if there is
2819 ## multiple nodes with the same qualified name.
2820
2821 NS: for my $__ns (sort {$a cmp $b} keys %$__attr) {
2822 for my $__ln (sort {$a cmp $b} keys %{$__attr->{$__ns}}) {
2823 my $__node = $__attr->{$__ns}->{$__ln};
2824 if ($__node->
2825 node_name eq
2826 $name) {
2827
2828
2829 {
2830
2831
2832 $node = $__node;
2833
2834
2835
2836 }
2837
2838 ;
2839
2840
2841 ;
2842 last NS;
2843 }
2844 } # ln
2845 } # NS
2846
2847
2848 }
2849
2850 ;
2851 $r = defined $node;
2852
2853
2854 }
2855 $r}
2856 sub has_attribute_ns ($$$) {
2857 my ($self, $namespaceURI, $localName) = @_;
2858
2859 {
2860
2861 if
2862 (CORE::defined $namespaceURI and CORE::length $namespaceURI == 0) {
2863 require Message::DOM::DOMMain;
2864
2865 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:1167522123:25685:fj3zF510';
2866
2867 ;
2868
2869 $namespaceURI = undef;
2870 }
2871
2872
2873 }
2874 my $r = 0;
2875
2876 {
2877
2878 my
2879 $node;
2880
2881
2882 {
2883
2884 my
2885 $__attrs = ${$self}->{
2886 'attr'
2887 };
2888 if (defined $__attrs->{defined $namespaceURI ? $namespaceURI : ''}
2889 ->{$localName}) {
2890 $node = $__attrs->{defined $namespaceURI ? $namespaceURI : ''}
2891 ->{$localName};
2892 }
2893
2894
2895 }
2896
2897 ;
2898 $r = defined $node;
2899
2900
2901 }
2902 $r}
2903 sub set_attribute ($$$) {
2904 my ($self, $name, $value) = @_;
2905
2906 {
2907
2908 my
2909 $od = $self->
2910 owner_document
2911 ;
2912 if ($od->
2913 strict_error_checking
2914 ) {
2915 if ($self->
2916 manakai_read_only
2917 ) {
2918
2919 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';
2920
2921 ;
2922 }
2923 my $version = $od->
2924 xml_version
2925 ;
2926
2927
2928 {
2929
2930 if
2931 (defined $name) {
2932 if (((not defined $version or $version eq '1.0') and
2933 not
2934 ($name =~ /\A\p{InXML_NameStartChar10}\p{InXMLNameChar10}*\z/)
2935 ) or
2936 (defined $version and $version eq '1.1' and
2937 not
2938 ($name =~ /\A\p{InXMLNameStartChar11}\p{InXMLNameChar11}*\z/)
2939 )) {
2940
2941 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' => 'http://suika.fam.cx/~wakaba/archive/2004/dom/main#ensureXMLName', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => '$INPUT_PARAM_NAME';
2942
2943 ;
2944 }
2945 }
2946
2947
2948 }
2949
2950 ;
2951 }
2952
2953 my $__anode;
2954
2955
2956 {
2957
2958 my
2959 $__attr = ${$self}->{
2960 'attr'
2961 };
2962
2963 ## Note that we no longer support DOM Level 1 nodes.
2964
2965 ## If an attribute's qualified name is equal to
2966 ## the requested name, then the node is the answer.
2967
2968 ## Note that if there is a namespace ill-formed attribute,
2969 ## the result is not the expected one. For example,
2970 ## if an |xmlns| attribute in the |http://www.w3.org/2000/xmlns/|
2971 ## namespace has non-NULL |prefix|, a request to get |xmlns|
2972 ## attribute will not return that node.
2973
2974 ## |sort|ing is required so that every |getAttribute|, |setAttribute|,
2975 ## |hasAttribute|, |removeAttribute|, or any other namespace unaware
2976 ## methods operates on the same node even if there is
2977 ## multiple nodes with the same qualified name.
2978
2979 NS: for my $__ns (sort {$a cmp $b} keys %$__attr) {
2980 for my $__ln (sort {$a cmp $b} keys %{$__attr->{$__ns}}) {
2981 my $__node = $__attr->{$__ns}->{$__ln};
2982 if ($__node->
2983 node_name eq
2984 $name) {
2985
2986
2987 {
2988
2989
2990 $__anode = $__node;
2991
2992
2993
2994 }
2995
2996 ;
2997
2998
2999 ;
3000 last NS;
3001 }
3002 } # ln
3003 } # NS
3004
3005
3006 }
3007
3008 ;
3009 if (defined $__anode) { ## There is already a node with such a |name|
3010 if ($__anode->
3011 manakai_read_only
3012 ) {
3013
3014 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;
3015
3016 ;
3017 }
3018 } else { ## There is no such attribute
3019
3020
3021 {
3022
3023 local $Error::Depth = $Error::Depth + 1;
3024
3025 {
3026
3027
3028
3029 $__anode = $od->
3030 create_attribute
3031 ($name);
3032 CORE::delete $$self->{
3033 'sattrs'
3034 };
3035 my $__attrs = $$self->{
3036 'attr'
3037 };
3038 $__attrs->{''}->{$name} = $__anode;
3039 $$__anode->{
3040 'owner'
3041 } = $self;
3042 Scalar::Util::weaken ($$__anode->{
3043 'owner'
3044 });
3045
3046
3047
3048 }
3049
3050
3051 ;}
3052
3053 ;
3054
3055
3056 {
3057
3058
3059 ## NOTE: The |cfg:xml-id| configuration parameter does not matter
3060 ## since it can be typed in the |createAttribute| method.
3061
3062
3063
3064 {
3065
3066 local $Error::Depth = $Error::Depth + 1;
3067
3068 {
3069
3070
3071 if
3072 ($od->
3073 dom_config
3074
3075 ->
3076 get_parameter
3077
3078 (
3079 'http://suika.fam.cx/www/2006/dom-config/dtd-attribute-type'
3080 )) {
3081 my $__st_doctype = $od->
3082 doctype
3083 ;
3084 $__st_doctype = $__st_doctype->
3085 get_feature
3086
3087 (
3088 'http://suika.fam.cx/www/2006/feature/XDoctype'
3089 => '3.0')
3090 if defined $__st_doctype;
3091 if (defined $__st_doctype) {
3092 my $__st_et = $__st_doctype->
3093 get_element_type_definition_node
3094
3095 ($self->
3096 node_name
3097 );
3098 if (defined $__st_et) {
3099 my $__st_at = $__st_et->
3100 get_attribute_definition_node
3101
3102 ($name);
3103 if (defined $__st_at) {
3104 $__anode->
3105 manakai_attribute_type
3106
3107 ($__st_at->
3108 declared_type
3109 );
3110 }
3111 }
3112 }
3113 }
3114
3115
3116
3117 }
3118
3119
3120 ;}
3121
3122 ;
3123
3124
3125 }
3126
3127 ;
3128 }
3129
3130
3131 {
3132
3133 local $Error::Depth = $Error::Depth + 1;
3134
3135 {
3136
3137
3138
3139 $__anode->
3140 value
3141 ($value);
3142 $__anode->
3143 specified
3144 (
3145 1
3146 );
3147
3148
3149
3150 }
3151
3152
3153 ;}
3154
3155 ;
3156
3157
3158 }
3159 }
3160 sub set_attribute_ns ($$$$) {
3161 my ($self, $namespaceURI, $qualifiedName, $value) = @_;
3162
3163 {
3164
3165 if
3166 (CORE::defined $namespaceURI and CORE::length $namespaceURI == 0) {
3167 require Message::DOM::DOMMain;
3168
3169 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:1167522123:25685:fj3zF510';
3170
3171 ;
3172
3173 $namespaceURI = undef;
3174 }
3175
3176
3177 }
3178
3179 {
3180
3181 my
3182 ($prefix, $localName) = ref $qualifiedName eq 'ARRAY'
3183 ? @$qualifiedName
3184 : split /:/, $qualifiedName, 2;
3185 ($prefix, $localName) = (
3186 undef
3187 , $prefix) unless defined $localName;
3188
3189 my $od = $self->
3190 owner_document
3191 ;
3192 if ($od->
3193 strict_error_checking
3194 ) {
3195 if ($self->
3196 manakai_read_only
3197 ) {
3198
3199 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';
3200
3201 ;
3202 }
3203 my $version = $od->
3204 xml_version
3205 ;
3206 $qualifiedName = defined $prefix ? $prefix.':'.$localName
3207 : $localName;
3208
3209
3210 {
3211
3212 if
3213 (defined $version and $version eq '1.1') {
3214 unless (
3215 ($qualifiedName =~ /\A\p{InXMLNameStartChar11}\p{InXMLNameChar11}*\z/)
3216 ) {
3217
3218 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' => 'http://suika.fam.cx/~wakaba/archive/2004/dom/main#ensureXMLQName', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => '$INPUT_NAME';
3219
3220 ;
3221 }
3222 unless (
3223 ($qualifiedName =~ /\A\p{InXMLNCNameStartChar11}\p{InXMLNCNameChar11}*(?::\p{InXMLNCNameStartChar11}\p{InXMLNCNameChar11}*)?\z/)
3224 ) {
3225
3226 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' => 'http://suika.fam.cx/~wakaba/archive/2004/dom/main#ensureXMLQName', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => '$INPUT_NAME';
3227
3228 ;
3229 }
3230 } else {
3231 unless (
3232 ($qualifiedName =~ /\A\p{InXML_NameStartChar10}\p{InXMLNameChar10}*\z/)
3233 ) {
3234
3235 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' => 'http://suika.fam.cx/~wakaba/archive/2004/dom/main#ensureXMLQName', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => '$INPUT_NAME';
3236
3237 ;
3238 }
3239 unless (
3240 ($qualifiedName =~ /\A\p{InXML_NCNameStartChar10}\p{InXMLNCNameChar10}*(?::\p{InXML_NCNameStartChar10}\p{InXMLNCNameChar10}*)?\z/)
3241 ) {
3242
3243 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' => 'http://suika.fam.cx/~wakaba/archive/2004/dom/main#ensureXMLQName', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => '$INPUT_NAME';
3244
3245 ;
3246 }
3247 }
3248
3249
3250 }
3251
3252 ;
3253
3254
3255 {
3256
3257 if
3258 (defined $prefix) {
3259 if (not defined $namespaceURI) {
3260
3261 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' => 'http://suika.fam.cx/~wakaba/archive/2004/dom/main#checkXMLNamesQName';
3262
3263 ;
3264 } elsif ($prefix eq 'xml' and $namespaceURI ne
3265 'http://www.w3.org/XML/1998/namespace'
3266 ) {
3267
3268 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' => 'http://suika.fam.cx/~wakaba/archive/2004/dom/main#checkXMLNamesQName';
3269
3270 ;
3271 } elsif ($prefix eq 'xmlns' and $namespaceURI ne
3272 'http://www.w3.org/2000/xmlns/'
3273 ) {
3274
3275 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' => 'http://suika.fam.cx/~wakaba/archive/2004/dom/main#checkXMLNamesQName';
3276
3277 ;
3278 } elsif ($namespaceURI eq
3279 'http://www.w3.org/XML/1998/namespace' and
3280 $prefix ne 'xml') {
3281
3282 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' => 'http://suika.fam.cx/~wakaba/archive/2004/dom/main#checkXMLNamesQName';
3283
3284 ;
3285 } elsif ($namespaceURI eq
3286 'http://www.w3.org/2000/xmlns/' and
3287 $prefix ne 'xmlns') {
3288
3289 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' => 'http://suika.fam.cx/~wakaba/archive/2004/dom/main#checkXMLNamesQName';
3290
3291 ;
3292 }
3293 } else { ## No prefix
3294 if (not defined $namespaceURI) {
3295 #
3296 } elsif ($namespaceURI eq
3297 'http://www.w3.org/2000/xmlns/' and
3298 $localName ne 'xmlns') {
3299
3300 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' => 'http://suika.fam.cx/~wakaba/archive/2004/dom/main#checkXMLNamesQName';
3301
3302 ;
3303 }
3304 }
3305
3306
3307 }
3308
3309 ;
3310 }
3311
3312
3313 {
3314
3315 my
3316 $__anode;
3317
3318
3319 {
3320
3321 my
3322 $__attrs = ${$self}->{
3323 'attr'
3324 };
3325 if (defined $__attrs->{defined $namespaceURI ? $namespaceURI : ''}
3326 ->{$localName}) {
3327 $__anode = $__attrs->{defined $namespaceURI ? $namespaceURI : ''}
3328 ->{$localName};
3329 }
3330
3331
3332 }
3333
3334 ;
3335 if (defined $__anode) { ## There is already a node with such a |name|
3336 if ($__anode->
3337 manakai_read_only
3338 ) {
3339
3340 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' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/setAttrValueNS', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#node' => $__anode;
3341
3342 ;
3343 }
3344 $__anode->
3345 prefix
3346 ($prefix) if defined $prefix;
3347 ## ISSUE: Should NULL be allowed here with |strictErrorChecking| off?
3348 } else { ## There is no such attribute
3349
3350
3351 {
3352
3353 local $Error::Depth = $Error::Depth + 1;
3354
3355 {
3356
3357
3358
3359 $__anode = $od->
3360 create_attribute_ns
3361
3362 ($namespaceURI, [$prefix, $localName]);
3363 CORE::delete $$self->{
3364 'sattrs'
3365 };
3366 my $__attrs = ${$self}->{
3367 'attr'
3368 };
3369 $__attrs->{defined $namespaceURI ? $namespaceURI : ''}->{$localName}
3370 = $__anode;
3371 $$__anode->{
3372 'owner'
3373 } = $self;
3374 Scalar::Util::weaken ($$__anode->{
3375 'owner'
3376 });
3377
3378
3379
3380 }
3381
3382
3383 ;}
3384
3385 ;
3386
3387
3388 {
3389
3390
3391 ## NOTE: The |cfg:xml-id| configuration parameter does not matter
3392 ## since it can be typed in the |createAttribute| method.
3393
3394
3395
3396 {
3397
3398 local $Error::Depth = $Error::Depth + 1;
3399
3400 {
3401
3402
3403 if
3404 ($od->
3405 dom_config
3406
3407 ->
3408 get_parameter
3409
3410 (
3411 'http://suika.fam.cx/www/2006/dom-config/dtd-attribute-type'
3412 )) {
3413 my $__st_doctype = $od->
3414 doctype
3415 ;
3416 $__st_doctype = $__st_doctype->
3417 get_feature
3418
3419 (
3420 'http://suika.fam.cx/www/2006/feature/XDoctype'
3421 => '3.0')
3422 if defined $__st_doctype;
3423 if (defined $__st_doctype) {
3424 my $__st_et = $__st_doctype->
3425 get_element_type_definition_node
3426
3427 ($self->
3428 node_name
3429 );
3430 if (defined $__st_et) {
3431 my $__st_at = $__st_et->
3432 get_attribute_definition_node
3433
3434 (defined $prefix ? $prefix.':'.$localName
3435 : $localName);
3436 if (defined $__st_at) {
3437 $__anode->
3438 manakai_attribute_type
3439
3440 ($__st_at->
3441 declared_type
3442 );
3443 }
3444 }
3445 }
3446 }
3447
3448
3449
3450 }
3451
3452
3453 ;}
3454
3455 ;
3456
3457
3458 }
3459
3460 ;
3461 }
3462
3463
3464 {
3465
3466 local $Error::Depth = $Error::Depth + 1;
3467
3468 {
3469
3470
3471
3472 $__anode->
3473 value
3474 (defined $value ? $value : '');
3475 $__anode->
3476 specified
3477 (
3478 1
3479 );
3480
3481
3482
3483 }
3484
3485
3486 ;}
3487
3488 ;
3489
3490
3491 }
3492
3493 ;
3494
3495
3496 }
3497 }
3498 sub set_attribute_node ($$) {
3499 my ($self, $newAttr) = @_;
3500 my $r;
3501
3502 {
3503
3504 my
3505 $self_od = $self->
3506 owner_document
3507 ;
3508 my $strict = $self_od->
3509 strict_error_checking
3510 ;
3511 if ($strict and
3512 not $self_od eq $newAttr->
3513 owner_document
3514 ) {
3515
3516 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;
3517
3518 ;
3519 }
3520
3521 my $nsuri = $newAttr->
3522 namespace_uri
3523 ;
3524 $nsuri = '' unless defined $nsuri;
3525 my $ln = $newAttr->
3526 local_name
3527 ;
3528 CORE::delete $$self->{
3529 'sattrs'
3530 };
3531 my $attrs = $$self->{
3532 'attr'
3533 };
3534 my $current = $attrs->{$nsuri}->{$ln};
3535
3536 if (defined $newAttr->
3537 owner_element
3538 ) {
3539 if (defined $current and $current eq $newAttr) {
3540
3541 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';
3542
3543 ;
3544 ## No return value
3545 } else {
3546
3547 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;
3548
3549 ;
3550 }
3551 } else { # not in use
3552 if ($strict and $self->
3553 manakai_read_only
3554 ) {
3555
3556 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';
3557
3558 ;
3559 }
3560
3561 $attrs->{$nsuri}->{$ln} = $newAttr;
3562 $$newAttr->{
3563 'owner'
3564 } = $self;
3565 Scalar::Util::weaken ($$newAttr->{
3566 'owner'
3567 });
3568 $newAttr->
3569 specified
3570 (
3571 1
3572 );
3573
3574 if (defined $current) {
3575 CORE::delete $$current->{
3576 'owner'
3577 };
3578 $r = $current;
3579 }
3580 }
3581
3582
3583 }
3584 $r}
3585 sub set_attribute_node_ns ($$) {
3586 my ($self, $newAttr) = @_;
3587 my $r;
3588
3589 {
3590
3591 my
3592 $self_od = $self->
3593 owner_document
3594 ;
3595 my $strict = $self_od->
3596 strict_error_checking
3597 ;
3598 if ($strict and
3599 not $self_od eq $newAttr->
3600 owner_document
3601 ) {
3602
3603 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;
3604
3605 ;
3606 }
3607
3608 my $nsuri = $newAttr->
3609 namespace_uri
3610 ;
3611 $nsuri = '' unless defined $nsuri;
3612 my $ln = $newAttr->
3613 local_name
3614 ;
3615 CORE::delete $$self->{
3616 'sattrs'
3617 };
3618 my $attrs = $$self->{
3619 'attr'
3620 };
3621 my $current = $attrs->{$nsuri}->{$ln};
3622
3623 if (defined $newAttr->
3624 owner_element
3625 ) {
3626 if (defined $current and $current eq $newAttr) {
3627
3628 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';
3629
3630 ;
3631 ## No return value
3632 } else {
3633
3634 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;
3635
3636 ;
3637 }
3638 } else { # not in use
3639 if ($strict and $self->
3640 manakai_read_only
3641 ) {
3642
3643 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';
3644
3645 ;
3646 }
3647
3648 $attrs->{$nsuri}->{$ln} = $newAttr;
3649 $$newAttr->{
3650 'owner'
3651 } = $self;
3652 Scalar::Util::weaken ($$newAttr->{
3653 'owner'
3654 });
3655 $newAttr->
3656 specified
3657 (
3658 1
3659 );
3660
3661 if (defined $current) {
3662 CORE::delete $$current->{
3663 'owner'
3664 };
3665 $r = $current;
3666 }
3667 }
3668
3669
3670 }
3671 $r}
3672 sub remove_attribute ($$) {
3673 my ($self, $name) = @_;
3674
3675 {
3676
3677 my
3678 $list;
3679 my $key;
3680 my $attr;
3681
3682
3683 {
3684
3685 my
3686 $__attr = ${$self}->{
3687 'attr'
3688 };
3689
3690 ## Note that we no longer support DOM Level 1 nodes.
3691
3692 ## If an attribute's qualified name is equal to
3693 ## the requested name, then the node is the answer.
3694
3695 ## Note that if there is a namespace ill-formed attribute,
3696 ## the result is not the expected one. For example,
3697 ## if an |xmlns| attribute in the |http://www.w3.org/2000/xmlns/|
3698 ## namespace has non-NULL |prefix|, a request to get |xmlns|
3699 ## attribute will not return that node.
3700
3701 ## |sort|ing is required so that every |getAttribute|, |setAttribute|,
3702 ## |hasAttribute|, |removeAttribute|, or any other namespace unaware
3703 ## methods operates on the same node even if there is
3704 ## multiple nodes with the same qualified name.
3705
3706 NS: for my $__ns (sort {$a cmp $b} keys %$__attr) {
3707 for my $__ln (sort {$a cmp $b} keys %{$__attr->{$__ns}}) {
3708 my $__node = $__attr->{$__ns}->{$__ln};
3709 if ($__node->
3710 node_name eq
3711 $name) {
3712
3713
3714 ;
3715
3716
3717 {
3718
3719
3720 $attr = $__node;
3721 $list = $__attr->{$__ns};
3722 $key = $__ln;
3723 CORE::delete ${$__node}->{
3724 'sattrs'
3725 };
3726
3727
3728
3729 }
3730
3731 ;
3732 last NS;
3733 }
3734 } # ln
3735 } # NS
3736
3737
3738 }
3739
3740 ;
3741 if (defined $attr) {
3742 if ($self->
3743 manakai_read_only
3744 ) {
3745
3746 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';
3747
3748 ;
3749 }
3750
3751 ## Remove the attribute node
3752 CORE::delete $list->{$key};
3753 CORE::delete $$attr->{
3754 'owner'
3755 };
3756
3757 ## Default attribute
3758 my $doc = $self->
3759 owner_document
3760 ;
3761 my $doc_cfg = $doc->
3762 dom_config
3763 ;
3764 if ($doc_cfg->
3765 get_parameter
3766
3767 (
3768 'http://suika.fam.cx/www/2006/dom-config/dtd-default-attribute'
3769 )) {
3770 my $prefix;
3771
3772
3773 {
3774
3775
3776 {
3777
3778 local $Error::Depth = $Error::Depth + 1;
3779
3780 {
3781
3782
3783 my
3784 $__doctype = $doc->
3785 doctype
3786 ;
3787 $__doctype = $__doctype->
3788 get_feature
3789 (
3790 'http://suika.fam.cx/www/2006/feature/XDoctype'
3791 )
3792 if $__doctype;
3793 if (defined $__doctype) {
3794 my $__et = $__doctype->
3795 get_element_type_definition_node
3796
3797 ($self->node_name);
3798 if (defined $__et) {
3799 my $__orig_strict = $doc->
3800 strict_error_checking
3801 ;
3802 $doc->
3803 strict_error_checking
3804 (
3805 0
3806 );
3807
3808 my $__at = $__et->
3809 get_attribute_definition_node
3810 ($name);
3811 if (defined $__at) {
3812 my $__copy_asis = $doc_cfg->
3813 get_parameter
3814
3815 (
3816 'http://suika.fam.cx/www/2006/dom-config/clone-entity-reference-subtree'
3817 );
3818 $doc_cfg->
3819 set_parameter
3820
3821 (
3822 'http://suika.fam.cx/www/2006/dom-config/clone-entity-reference-subtree'
3823 =>
3824 1
3825 );
3826 ADD: {
3827 my $__attr;
3828 CORE::delete $$self->{
3829 'sattrs'
3830 };
3831 my $__attrs = ${$self}->{
3832 'attr'
3833 };
3834 if (defined $prefix) { ## prefixed attr
3835 my $__nsuri = $self->
3836 lookup_namespace_uri
3837
3838 ($prefix);
3839 unless (defined $__nsuri) {
3840 ## TODO: Namespace well-formedness error
3841 }
3842 if (defined $__attrs->{defined $__nsuri ? $__nsuri : ''}
3843 ->{$name}) {
3844 ## TODO: Namespace well-formedness warning?
3845 last ADD;
3846 }
3847 $__attr = $doc->
3848 create_attribute_ns
3849
3850 ($__nsuri, [$prefix, $name]);
3851 } else { ## local attr
3852 if ($name eq 'xmlns') {
3853 if (defined $__attrs->{
3854 'http://www.w3.org/2000/xmlns/'
3855 }->{xmlns}) {
3856 ## TODO: Namespace well-formedness warning?
3857 last ADD;
3858 }
3859 $__attr = $doc->
3860 create_attribute_ns
3861
3862 (
3863 'http://www.w3.org/2000/xmlns/'
3864 , 'xmlns');
3865 } else {
3866 if (defined $__attrs->{''}->{$name}) {
3867 ## TODO: Namespace well-formedness warning?
3868 last ADD;
3869 }
3870 $__attr = $doc->
3871 create_attribute
3872 ($name);
3873 }
3874 }
3875 for my $__at_child (@{$__at->
3876 child_nodes
3877 }) {
3878 $__attr->
3879 append_child
3880
3881 ($__at_child->
3882 clone_node
3883 (
3884 1
3885 ));
3886 }
3887 $__attr->
3888 manakai_attribute_type
3889
3890 ($__at->
3891 declared_type
3892 );
3893 $self->
3894 set_attribute_node_ns
3895 ($__attr);
3896 ## This method change the |specified| flag
3897 $__attr->
3898 specified
3899 (
3900 0
3901 );
3902 } # ADD
3903 $doc_cfg->
3904 set_parameter
3905
3906 (
3907 'http://suika.fam.cx/www/2006/dom-config/clone-entity-reference-subtree'
3908 => $__copy_asis);
3909 }
3910 $doc->
3911 strict_error_checking
3912 ($__orig_strict);
3913 } # et
3914 } # doctype
3915
3916
3917
3918 }
3919
3920
3921 ;}
3922
3923 ;
3924
3925
3926 }
3927
3928 ;
3929 }
3930 } # exists
3931
3932
3933 }
3934 }
3935 sub remove_attribute_ns ($$$) {
3936 my ($self, $namespaceURI, $localName) = @_;
3937
3938 {
3939
3940 if
3941 (CORE::defined $namespaceURI and CORE::length $namespaceURI == 0) {
3942 require Message::DOM::DOMMain;
3943
3944 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:1167522123:25685:fj3zF510';
3945
3946 ;
3947
3948 $namespaceURI = undef;
3949 }
3950
3951
3952 }
3953
3954 {
3955
3956 my
3957 $list;
3958 my $attr;
3959
3960
3961 {
3962
3963 my
3964 $__attrs = ${$self}->{
3965 'attr'
3966 };
3967 $list = $__attrs->{defined $namespaceURI ? $namespaceURI : ''};
3968 if (defined $list and defined $list->{$localName}) {
3969 $attr = $__attrs->{defined $namespaceURI ? $namespaceURI : ''}
3970 ->{$localName};
3971 CORE::delete ${$self}->{
3972 'sattrs'
3973 };
3974 }
3975
3976
3977 }
3978
3979 ;
3980 if (defined $attr) {
3981 if ($self->
3982 manakai_read_only
3983 ) {
3984
3985 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';
3986
3987 ;
3988 }
3989
3990 ## Removes the attribute node
3991 CORE::delete $list->{$localName};
3992 CORE::delete $$attr->{
3993 'owner'
3994 };
3995
3996 ## Default attribute
3997 my $doc = $self->
3998 owner_document
3999 ;
4000 my $doc_cfg = $doc->
4001 dom_config
4002 ;
4003 if ($doc_cfg->
4004 get_parameter
4005
4006 (
4007 'http://suika.fam.cx/www/2006/dom-config/dtd-default-attribute'
4008 )) {
4009 my $pfx = $attr->
4010 prefix
4011 ;
4012 my $name = defined $pfx ? $pfx.':'.$localName : $localName;
4013
4014
4015 {
4016
4017
4018 {
4019
4020 local $Error::Depth = $Error::Depth + 1;
4021
4022 {
4023
4024
4025 my
4026 $__doctype = $doc->
4027 doctype
4028 ;
4029 $__doctype = $__doctype->
4030 get_feature
4031 (
4032 'http://suika.fam.cx/www/2006/feature/XDoctype'
4033 )
4034 if $__doctype;
4035 if (defined $__doctype) {
4036 my $__et = $__doctype->
4037 get_element_type_definition_node
4038
4039 ($self->node_name);
4040 if (defined $__et) {
4041 my $__orig_strict = $doc->
4042 strict_error_checking
4043 ;
4044 $doc->
4045 strict_error_checking
4046 (
4047 0
4048 );
4049
4050 my $__at = $__et->
4051 get_attribute_definition_node
4052 ($name);
4053 if (defined $__at) {
4054 my $__copy_asis = $doc_cfg->
4055 get_parameter
4056
4057 (
4058 'http://suika.fam.cx/www/2006/dom-config/clone-entity-reference-subtree'
4059 );
4060 $doc_cfg->
4061 set_parameter
4062
4063 (
4064 'http://suika.fam.cx/www/2006/dom-config/clone-entity-reference-subtree'
4065 =>
4066 1
4067 );
4068 ADD: {
4069 my $__attr;
4070 CORE::delete $$self->{
4071 'sattrs'
4072 };
4073 my $__attrs = ${$self}->{
4074 'attr'
4075 };
4076 if (defined $pfx) { ## prefixed attr
4077 my $__nsuri = $self->
4078 lookup_namespace_uri
4079
4080 ($pfx);
4081 unless (defined $__nsuri) {
4082 ## TODO: Namespace well-formedness error
4083 }
4084 if (defined $__attrs->{defined $__nsuri ? $__nsuri : ''}
4085 ->{$localName}) {
4086 ## TODO: Namespace well-formedness warning?
4087 last ADD;
4088 }
4089 $__attr = $doc->
4090 create_attribute_ns
4091
4092 ($__nsuri, [$pfx, $localName]);
4093 } else { ## local attr
4094 if ($name eq 'xmlns') {
4095 if (defined $__attrs->{
4096 'http://www.w3.org/2000/xmlns/'
4097 }->{xmlns}) {
4098 ## TODO: Namespace well-formedness warning?
4099 last ADD;
4100 }
4101 $__attr = $doc->
4102 create_attribute_ns
4103
4104 (
4105 'http://www.w3.org/2000/xmlns/'
4106 , 'xmlns');
4107 } else {
4108 if (defined $__attrs->{''}->{$name}) {
4109 ## TODO: Namespace well-formedness warning?
4110 last ADD;
4111 }
4112 $__attr = $doc->
4113 create_attribute
4114 ($name);
4115 }
4116 }
4117 for my $__at_child (@{$__at->
4118 child_nodes
4119 }) {
4120 $__attr->
4121 append_child
4122
4123 ($__at_child->
4124 clone_node
4125 (
4126 1
4127 ));
4128 }
4129 $__attr->
4130 manakai_attribute_type
4131
4132 ($__at->
4133 declared_type
4134 );
4135 $self->
4136 set_attribute_node_ns
4137 ($__attr);
4138 ## This method change the |specified| flag
4139 $__attr->
4140 specified
4141 (
4142 0
4143 );
4144 } # ADD
4145 $doc_cfg->
4146 set_parameter
4147
4148 (
4149 'http://suika.fam.cx/www/2006/dom-config/clone-entity-reference-subtree'
4150 => $__copy_asis);
4151 }
4152 $doc->
4153 strict_error_checking
4154 ($__orig_strict);
4155 } # et
4156 } # doctype
4157
4158
4159
4160 }
4161
4162
4163 ;}
4164
4165 ;
4166
4167
4168 }
4169
4170 ;
4171 }
4172 } # exists
4173
4174
4175 }
4176 }
4177 sub remove_attribute_node ($$) {
4178 my ($self, $oldAttr) = @_;
4179 my $r;
4180
4181 {
4182
4183 my
4184 $od = $self->
4185 owner_document
4186 ;
4187 if ($od->
4188 strict_error_checking and
4189
4190 $self->
4191 manakai_read_only
4192 ) {
4193
4194 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';
4195
4196 ;
4197 }
4198
4199 my $ln = $oldAttr->
4200 local_name
4201 ;
4202 FIND: {
4203 CORE::delete $$self->{
4204 'sattrs'
4205 };
4206 my $attrs = $$self->{
4207 'attr'
4208 };
4209 my $nsuri = $oldAttr->
4210 namespace_uri
4211 ;
4212 my $list = $attrs->{defined $nsuri ? $nsuri : ''};
4213 my $list_node = $list->{$ln};
4214 if (defined $list_node and $list_node eq $oldAttr) {
4215 CORE::delete $list->{$ln};
4216 last FIND;
4217 }
4218
4219 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;
4220
4221 ;
4222 } # FIND
4223
4224 CORE::delete $$oldAttr->{
4225 'owner'
4226 };
4227 $r = $oldAttr;
4228
4229 ## Default attribute
4230 my $doc_cfg = $od->
4231 dom_config
4232 ;
4233 if ($doc_cfg->
4234 get_parameter
4235
4236 (
4237 'http://suika.fam.cx/www/2006/dom-config/dtd-default-attribute'
4238 )) {
4239 my $name = $oldAttr->
4240 node_name
4241 ;
4242 my $pfx = $oldAttr->
4243 prefix
4244 ;
4245
4246
4247 {
4248
4249
4250 {
4251
4252 local $Error::Depth = $Error::Depth + 1;
4253
4254 {
4255
4256
4257 my
4258 $__doctype = $od->
4259 doctype
4260 ;
4261 $__doctype = $__doctype->
4262 get_feature
4263 (
4264 'http://suika.fam.cx/www/2006/feature/XDoctype'
4265 )
4266 if $__doctype;
4267 if (defined $__doctype) {
4268 my $__et = $__doctype->
4269 get_element_type_definition_node
4270
4271 ($self->node_name);
4272 if (defined $__et) {
4273 my $__orig_strict = $od->
4274 strict_error_checking
4275 ;
4276 $od->
4277 strict_error_checking
4278 (
4279 0
4280 );
4281
4282 my $__at = $__et->
4283 get_attribute_definition_node
4284 ($name);
4285 if (defined $__at) {
4286 my $__copy_asis = $doc_cfg->
4287 get_parameter
4288
4289 (
4290 'http://suika.fam.cx/www/2006/dom-config/clone-entity-reference-subtree'
4291 );
4292 $doc_cfg->
4293 set_parameter
4294
4295 (
4296 'http://suika.fam.cx/www/2006/dom-config/clone-entity-reference-subtree'
4297 =>
4298 1
4299 );
4300 ADD: {
4301 my $__attr;
4302 CORE::delete $$self->{
4303 'sattrs'
4304 };
4305 my $__attrs = ${$self}->{
4306 'attr'
4307 };
4308 if (defined $pfx) { ## prefixed attr
4309 my $__nsuri = $self->
4310 lookup_namespace_uri
4311
4312 ($pfx);
4313 unless (defined $__nsuri) {
4314 ## TODO: Namespace well-formedness error
4315 }
4316 if (defined $__attrs->{defined $__nsuri ? $__nsuri : ''}
4317 ->{$ln}) {
4318 ## TODO: Namespace well-formedness warning?
4319 last ADD;
4320 }
4321 $__attr = $od->
4322 create_attribute_ns
4323
4324 ($__nsuri, [$pfx, $ln]);
4325 } else { ## local attr
4326 if ($name eq 'xmlns') {
4327 if (defined $__attrs->{
4328 'http://www.w3.org/2000/xmlns/'
4329 }->{xmlns}) {
4330 ## TODO: Namespace well-formedness warning?
4331 last ADD;
4332 }
4333 $__attr = $od->
4334 create_attribute_ns
4335
4336 (
4337 'http://www.w3.org/2000/xmlns/'
4338 , 'xmlns');
4339 } else {
4340 if (defined $__attrs->{''}->{$name}) {
4341 ## TODO: Namespace well-formedness warning?
4342 last ADD;
4343 }
4344 $__attr = $od->
4345 create_attribute
4346 ($name);
4347 }
4348 }
4349 for my $__at_child (@{$__at->
4350 child_nodes
4351 }) {
4352 $__attr->
4353 append_child
4354
4355 ($__at_child->
4356 clone_node
4357 (
4358 1
4359 ));
4360 }
4361 $__attr->
4362 manakai_attribute_type
4363
4364 ($__at->
4365 declared_type
4366 );
4367 $self->
4368 set_attribute_node_ns
4369 ($__attr);
4370 ## This method change the |specified| flag
4371 $__attr->
4372 specified
4373 (
4374 0
4375 );
4376 } # ADD
4377 $doc_cfg->
4378 set_parameter
4379
4380 (
4381 'http://suika.fam.cx/www/2006/dom-config/clone-entity-reference-subtree'
4382 => $__copy_asis);
4383 }
4384 $od->
4385 strict_error_checking
4386 ($__orig_strict);
4387 } # et
4388 } # doctype
4389
4390
4391
4392 }
4393
4394
4395 ;}
4396
4397 ;
4398
4399
4400 }
4401
4402 ;
4403 }
4404
4405
4406 }
4407 $r}
4408 sub schema_type_info ($;$) {
4409 if (@_ == 1) {my ($self) = @_;
4410 my $r;
4411
4412 {
4413
4414
4415 {
4416
4417 my
4418 $v = 0 || 0;
4419 $r = bless \$v,
4420 'Message::DOM::Element::ManakaiDOMDTDTypeInfo'
4421 ;
4422
4423
4424 }
4425
4426 ;
4427
4428
4429 }
4430 $r;
4431 } else {my ($self) = @_;
4432 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';
4433 }
4434 }
4435 sub get_elements_by_tag_name ($$) {
4436 my ($self, $name) = @_;
4437 my $r;
4438
4439 {
4440
4441
4442 $name = "$name";
4443 my $chk;
4444 if ($name eq '*') {
4445 $chk = sub {
4446 1
4447 };
4448 } else {
4449 $chk = sub {
4450 my $node = shift;
4451 my $nodeName = $node->
4452 node_name
4453 ;
4454 ($nodeName eq $name);
4455 };
4456 }
4457
4458
4459 {
4460
4461
4462 $r = bless \[$self, $chk],
4463 'Message::DOM::TreeCore::ManakaiDOMGetElementsNodeList'
4464 ;
4465
4466
4467 }
4468
4469 ;
4470
4471
4472 }
4473 $r}
4474 sub get_elements_by_tag_name_ns ($$$) {
4475 my ($self, $namespaceURI, $localName) = @_;
4476
4477 {
4478
4479 if
4480 (CORE::defined $namespaceURI and CORE::length $namespaceURI == 0) {
4481 require Message::DOM::DOMMain;
4482
4483 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:1167522123:25685:fj3zF510';
4484
4485 ;
4486
4487 $namespaceURI = undef;
4488 }
4489
4490
4491 }
4492 my $r;
4493
4494 {
4495
4496
4497 $namespaceURI = "$namespaceURI" if defined $namespaceURI;
4498 $localName = "$localName";
4499 my $chk;
4500 if (not defined $namespaceURI) {
4501 if ($localName eq '*') {
4502 $chk = sub {
4503 my $node = shift;
4504 (not defined $node->
4505 namespace_uri
4506 );
4507 };
4508 } else {
4509 $chk = sub {
4510 my $node = shift;
4511 (not defined $node->
4512 namespace_uri and
4513
4514 $node->
4515 local_name eq
4516 $localName);
4517 };
4518 }
4519 } elsif ($namespaceURI eq '*') {
4520 if ($localName eq '*') {
4521 $chk = sub {
4522 1
4523 };
4524 } else {
4525 $chk = sub {
4526 my $node = shift;
4527 ($node->
4528 local_name eq
4529 $localName);
4530 };
4531 }
4532 } else {
4533 if ($localName eq '*') {
4534 $chk = sub {
4535 my $node = shift;
4536 my $nsuri = $node->
4537 namespace_uri
4538 ;
4539 (defined $nsuri and $nsuri eq $namespaceURI);
4540 };
4541 } else {
4542 $chk = sub {
4543 my $node = shift;
4544 my $nsuri = $node->
4545 namespace_uri
4546 ;
4547 (defined $nsuri and $nsuri eq $namespaceURI and
4548 $node->
4549 local_name eq
4550 $localName);
4551 };
4552 }
4553 }
4554
4555
4556 {
4557
4558
4559 $r = bless \[$self, $chk],
4560 'Message::DOM::TreeCore::ManakaiDOMGetElementsNodeList'
4561 ;
4562
4563
4564 }
4565
4566 ;
4567
4568
4569 }
4570 $r}
4571 sub manakai_base_uri ($;$) {
4572 if (@_ == 1) {my ($self) = @_;
4573 my $r = '';
4574
4575 {
4576
4577
4578 $r = $$self->{
4579 'buri'
4580 };
4581
4582
4583 }
4584 $r;
4585 } else {my ($self, $given) = @_;
4586
4587 {
4588
4589
4590 {
4591
4592 if
4593 ($self->
4594 manakai_read_only
4595 ) {
4596
4597 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' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/NodeReadOnlyError';
4598
4599 ;
4600 }
4601
4602
4603 }
4604
4605 ;
4606 $$self->{
4607 'buri'
4608 } = $given;
4609
4610
4611 }
4612 }
4613 }
4614 sub set_id_attribute ($$;$) {
4615 my ($self, $name, $isId) = @_;
4616
4617 {
4618
4619
4620 {
4621
4622 if
4623 ($self->
4624 manakai_read_only
4625 ) {
4626
4627 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' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/NodeReadOnlyError';
4628
4629 ;
4630 }
4631
4632
4633 }
4634
4635 ;
4636 my $attr = $self->
4637 get_attribute_node
4638 ($name);
4639 if (not defined $attr) {
4640
4641 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;
4642
4643 ;
4644 } elsif ($attr->
4645 manakai_read_only
4646 ) {
4647
4648 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;
4649
4650 ;
4651 } else {
4652 $attr->
4653 is_id
4654 ($isId);
4655 }
4656
4657
4658 }
4659 }
4660 sub set_id_attribute_ns ($$$;$) {
4661 my ($self, $namespaceURI, $localName, $isId) = @_;
4662
4663 {
4664
4665 if
4666 (CORE::defined $namespaceURI and CORE::length $namespaceURI == 0) {
4667 require Message::DOM::DOMMain;
4668
4669 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:1167522123:25685:fj3zF510';
4670
4671 ;
4672
4673 $namespaceURI = undef;
4674 }
4675
4676
4677 }
4678
4679 {
4680
4681
4682 {
4683
4684 if
4685 ($self->
4686 manakai_read_only
4687 ) {
4688
4689 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' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/NodeReadOnlyError';
4690
4691 ;
4692 }
4693
4694
4695 }
4696
4697 ;
4698 my $attr = $self->
4699 get_attribute_node_ns
4700
4701 ($namespaceURI, $localName);
4702 if (not defined $attr) {
4703
4704 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;
4705
4706 ;
4707 } elsif ($attr->
4708 manakai_read_only
4709 ) {
4710
4711 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;
4712
4713 ;
4714 } else {
4715 $attr->
4716 is_id
4717 ($isId);
4718 }
4719
4720
4721 }
4722 }
4723 sub set_id_attribute_node ($$;$) {
4724 my ($self, $idAttr, $isId) = @_;
4725
4726 {
4727
4728
4729 {
4730
4731 if
4732 ($self->
4733 manakai_read_only
4734 ) {
4735
4736 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' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/NodeReadOnlyError';
4737
4738 ;
4739 }
4740
4741
4742 }
4743
4744 ;
4745
4746 my $owner = $idAttr->
4747 owner_element
4748 ;
4749 if (not defined $owner or not $owner eq $self) {
4750
4751 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;
4752
4753 ;
4754 } elsif ($idAttr->
4755 manakai_read_only
4756 ) {
4757
4758 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;
4759
4760 ;
4761 } else {
4762 $idAttr->
4763 is_id
4764 ($isId);
4765 }
4766
4767
4768 }
4769 }
4770 $Message::DOM::DOMFeature::ClassInfo->{q<Message::DOM::Element::ManakaiDOMElement>}->{has_feature} = {'core',
4771 {'',
4772 '1',
4773 '1.0',
4774 '1',
4775 '2.0',
4776 '1',
4777 '3.0',
4778 '1'},
4779 'xml',
4780 {'',
4781 '1',
4782 '1.0',
4783 '1',
4784 '2.0',
4785 '1',
4786 '3.0',
4787 '1'},
4788 'xmlversion',
4789 {'',
4790 '1',
4791 '1.0',
4792 '1',
4793 '1.1',
4794 '1'}};
4795 $Message::DOM::ClassPoint{q<Message::DOM::Element::ManakaiDOMElement>} = 14.1;
4796 package Message::DOM::IF::Attr;
4797 our $VERSION = 20061231.0208;
4798 package Message::DOM::Element::ManakaiDOMAttr;
4799 our $VERSION = 20061231.0208;
4800 push our @ISA, 'Message::DOM::TreeCore::ManakaiDOMNode',
4801 'Message::DOM::IF::Attr',
4802 'Message::DOM::IF::Node';
4803 use Char::Class::XML 'InXMLNameChar10',
4804 'InXMLNameChar11',
4805 'InXMLNameStartChar11',
4806 'InXML_NameStartChar10';
4807 sub node_type ($;$) {
4808 if (@_ == 1) {my ($self) = @_;
4809 my $r;
4810 $r = 2;
4811 $r;
4812 } else {my ($self) = @_;
4813 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';
4814 }
4815 }
4816 sub prefix ($;$) {
4817 if (@_ == 1) {my ($self) = @_;
4818 my $r = '';
4819
4820 {
4821
4822 my
4823 $v = $$self->{
4824 'pfx'
4825 };
4826 $r = defined $v ? $$v :
4827 undef
4828 ;
4829
4830
4831 }
4832 $r;
4833 } else {my ($self, $given) = @_;
4834
4835 {
4836
4837 my
4838 $od = $self->
4839 owner_document
4840 ;
4841 if ($od->
4842 strict_error_checking
4843 ) {
4844
4845
4846 {
4847
4848 if
4849 ($self->
4850 manakai_read_only
4851 ) {
4852
4853 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' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/NodeReadOnlyError';
4854
4855 ;
4856 }
4857
4858
4859 }
4860
4861 ;
4862 my $nsuri = $$self->{
4863 'ns'
4864 };
4865 if (not defined $nsuri) {
4866
4867 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';
4868
4869 ;
4870 } elsif ($$nsuri ne
4871 'http://www.w3.org/XML/1998/namespace' and
4872
4873 defined $given and $given eq 'xml') {
4874
4875 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';
4876
4877 ;
4878 } elsif ($$nsuri ne
4879 'http://www.w3.org/2000/xmlns/' and
4880
4881 defined $given and $given eq 'xmlns') {
4882
4883 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';
4884
4885 ;
4886 } elsif ($self->
4887 node_name eq
4888 'xmlns') {
4889
4890 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';
4891
4892 ;
4893 }
4894 my $version = $od->
4895 xml_version
4896 ;
4897
4898
4899 {
4900
4901 if
4902 (defined $given and $given eq '') {
4903 require Message::DOM::DOMMain;
4904
4905 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' => 'http://suika.fam.cx/~wakaba/archive/2004/dom/main#ensureNamespacePrefix';
4906
4907 ;
4908 undef $given;
4909 }
4910 if (defined $given) {
4911 if (($version eq '1.0' and
4912 not
4913 ($given =~ /\A\p{InXML_NameStartChar10}\p{InXMLNameChar10}*\z/)
4914 ) or
4915 ($version eq '1.1' and
4916 not
4917 ($given =~ /\A\p{InXMLNameStartChar11}\p{InXMLNameChar11}*\z/)
4918 )) {
4919
4920 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' => 'http://suika.fam.cx/~wakaba/archive/2004/dom/main#ensureNamespacePrefix', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => '$INPUT_PARAM_NAME';
4921
4922 ;
4923 } elsif (index ($given, ':') > -1) {
4924
4925 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' => 'http://suika.fam.cx/~wakaba/archive/2004/dom/main#ensureNamespacePrefix', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => '$INPUT_PARAM_NAME';
4926
4927 ;
4928 }
4929 } # has prefix
4930
4931
4932 }
4933
4934 ;
4935 } # strict
4936 if (defined $given) {
4937 $$self->{
4938 'pfx'
4939 } = \$given;
4940 } else {
4941 CORE::delete $$self->{
4942 'pfx'
4943 };
4944 }
4945
4946
4947 }
4948 }
4949 }
4950 sub append_child ($$) {
4951 my ($self, $newChild) = @_;
4952 my $r;
4953
4954 {
4955
4956 my
4957 $self_od = $self->
4958 owner_document
4959 ;
4960 my $child_od = $newChild->
4961 owner_document
4962 ;
4963 my $child_nt = $newChild->
4964 node_type
4965 ;
4966
4967
4968 {
4969
4970
4971 {
4972
4973 local $Error::Depth = $Error::Depth + 1;
4974
4975 {
4976
4977
4978 my
4979 $strict = $self_od->
4980 strict_error_checking
4981 ;
4982
4983 ## -- Node Type check
4984 my @new_child;
4985 if ({
4986 3 => 1,
4987 5 => 1,
4988 }->{$child_nt}) {
4989 push @new_child, $newChild;
4990 } elsif ($child_nt ==
4991 11
4992 ) {
4993 for my $cn (@{$newChild->
4994 child_nodes
4995 }) {
4996 unless ({
4997 3 => 1,
4998 5 => 1,
4999 }->{$cn->
5000 node_type
5001 }) {
5002
5003
5004 {
5005
5006 local $Error::Depth = $Error::Depth - 1;
5007
5008 {
5009
5010 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' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/appendChildImpl1', '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;
5011
5012
5013 }
5014
5015
5016 ;}
5017
5018 ;
5019 }
5020 push @new_child, $cn;
5021 }
5022 } else {
5023
5024
5025 {
5026
5027 local $Error::Depth = $Error::Depth - 1;
5028
5029 {
5030
5031 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' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/appendChildImpl1', '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;
5032
5033
5034 }
5035
5036
5037 ;}
5038
5039 ;
5040 }
5041
5042 my $nc_parent = @new_child ? $new_child[0]->
5043 parent_node
5044 :
5045
5046 undef
5047 ;
5048 if ($strict) {
5049 ## -- Wrong-document check
5050 unless ($self_od eq $child_od) {
5051
5052
5053 {
5054
5055 local $Error::Depth = $Error::Depth - 1;
5056
5057 {
5058
5059 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' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/appendChildImpl1', '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;
5060
5061
5062 }
5063
5064
5065 ;}
5066
5067 ;
5068 }
5069
5070 ## -- Read-onlyness check
5071 if ($self->
5072 manakai_read_only
5073 ) {
5074
5075
5076 {
5077
5078 local $Error::Depth = $Error::Depth - 1;
5079
5080 {
5081
5082 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' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/appendChildImpl1';
5083
5084
5085 }
5086
5087
5088 ;}
5089
5090 ;
5091 }
5092 if (@new_child) {
5093 if ($nc_parent and
5094 $nc_parent->
5095 manakai_read_only
5096 ) {
5097
5098
5099 {
5100
5101 local $Error::Depth = $Error::Depth - 1;
5102
5103 {
5104
5105 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' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/appendChildImpl1';
5106
5107
5108 }
5109
5110
5111 ;}
5112
5113 ;
5114 }
5115 }
5116 }
5117
5118 ## -- Insert at...
5119 my $index = -1; # last
5120
5121
5122 ; # FOR !tc:ForAppendChild
5123
5124 ## -- Removes from parent
5125 if ($nc_parent) {
5126 if ($child_nt ==
5127 11
5128 ) {
5129 $$newChild->{
5130 'child'
5131 } = [];
5132 } else {
5133 my $v = $$nc_parent->{
5134 'child'
5135 };
5136 RP: for my $i (0..$#$v) {
5137 if ($v->[$i] eq $new_child[0]) {
5138 splice @$v, $i, 1, ();
5139 last RP;
5140 }
5141 } # RP
5142 }
5143 }
5144
5145 ## -- Rewrite the |parentNode| properties
5146 for my $nc (@new_child) {
5147 $$nc->{
5148 'parent'
5149 } = $self;
5150 Scalar::Util::weaken ($$nc->{
5151 'parent'
5152 });
5153 }
5154
5155 my $children = $$self->{
5156 'child'
5157 };
5158
5159
5160
5161 {
5162
5163
5164 ## -- Adds to children list
5165 push @$children, @new_child;
5166 $r = $newChild;
5167
5168
5169
5170 }
5171
5172 ;
5173
5174
5175
5176 ;
5177
5178
5179
5180 ;
5181
5182
5183
5184 }
5185
5186
5187 ;}
5188
5189 ;
5190
5191
5192 }
5193
5194 ;
5195
5196
5197 }
5198 $r}
5199 sub insert_before ($$;$) {
5200 my ($self, $newChild, $refChild) = @_;
5201 my $r;
5202
5203 {
5204
5205 my
5206 $self_od = $self->
5207 owner_document
5208 ;
5209 my $child_od = $newChild->
5210 owner_document
5211 ;
5212 my $child_nt = $newChild->
5213 node_type
5214 ;
5215
5216
5217 {
5218
5219
5220 {
5221
5222 local $Error::Depth = $Error::Depth + 1;
5223
5224 {
5225
5226
5227 my
5228 $strict = $self_od->
5229 strict_error_checking
5230 ;
5231
5232 ## -- Node Type check
5233 my @new_child;
5234 if ({
5235 3 => 1,
5236 5 => 1,
5237 }->{$child_nt}) {
5238 push @new_child, $newChild;
5239 } elsif ($child_nt ==
5240 11
5241 ) {
5242 for my $cn (@{$newChild->
5243 child_nodes
5244 }) {
5245 unless ({
5246 3 => 1,
5247 5 => 1,
5248 }->{$cn->
5249 node_type
5250 }) {
5251
5252
5253 {
5254
5255 local $Error::Depth = $Error::Depth - 1;
5256
5257 {
5258
5259 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' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/insertBeforeImpl1', '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;
5260
5261
5262 }
5263
5264
5265 ;}
5266
5267 ;
5268 }
5269 push @new_child, $cn;
5270 }
5271 } else {
5272
5273
5274 {
5275
5276 local $Error::Depth = $Error::Depth - 1;
5277
5278 {
5279
5280 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' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/insertBeforeImpl1', '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;
5281
5282
5283 }
5284
5285
5286 ;}
5287
5288 ;
5289 }
5290
5291 my $nc_parent = @new_child ? $new_child[0]->
5292 parent_node
5293 :
5294
5295 undef
5296 ;
5297 if ($strict) {
5298 ## -- Wrong-document check
5299 unless ($self_od eq $child_od) {
5300
5301
5302 {
5303
5304 local $Error::Depth = $Error::Depth - 1;
5305
5306 {
5307
5308 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' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/insertBeforeImpl1', '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;
5309
5310
5311 }
5312
5313
5314 ;}
5315
5316 ;
5317 }
5318
5319 ## -- Read-onlyness check
5320 if ($self->
5321 manakai_read_only
5322 ) {
5323
5324
5325 {
5326
5327 local $Error::Depth = $Error::Depth - 1;
5328
5329 {
5330
5331 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' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/insertBeforeImpl1';
5332
5333
5334 }
5335
5336
5337 ;}
5338
5339 ;
5340 }
5341 if (@new_child) {
5342 if ($nc_parent and
5343 $nc_parent->
5344 manakai_read_only
5345 ) {
5346
5347
5348 {
5349
5350 local $Error::Depth = $Error::Depth - 1;
5351
5352 {
5353
5354 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' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/insertBeforeImpl1';
5355
5356
5357 }
5358
5359
5360 ;}
5361
5362 ;
5363 }
5364 }
5365 }
5366
5367 ## -- Insert at...
5368 my $index = -1; # last
5369
5370
5371 {
5372
5373
5374 # tc:ForAppendChild & tc:ForReplaceChild
5375 if (defined $refChild) {
5376 if ($refChild eq $newChild) {
5377
5378
5379 {
5380
5381
5382 {
5383
5384 local $Error::Depth = $Error::Depth - 1;
5385
5386 {
5387
5388 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' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/insertBeforeImpl1';
5389
5390
5391 }
5392
5393
5394 ;}
5395
5396 ;
5397
5398
5399
5400 }
5401
5402 ;
5403
5404
5405 ;
5406 }
5407
5408 my $cns = $self->
5409 child_nodes
5410 ;
5411 my $cnsl = @$cns;
5412 C: {
5413 $index = 0;
5414 for my $i (0..($cnsl-1)) {
5415 my $cn = $cns->[$i];
5416 if ($cn eq $refChild) {
5417 $index += $i;
5418 last C;
5419 } elsif ($cn eq $newChild) {
5420 $index = -1; # offset
5421 }
5422 }
5423
5424
5425 {
5426
5427
5428 {
5429
5430 local $Error::Depth = $Error::Depth - 1;
5431
5432 {
5433
5434 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' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/insertBeforeImpl1', '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;
5435
5436
5437 }
5438
5439
5440 ;}
5441
5442 ;
5443
5444
5445
5446 }
5447
5448 ;
5449
5450
5451 ;
5452 } # C
5453 } else { # |oldChild| is not defined
5454
5455
5456 ;
5457 }
5458
5459
5460
5461 }
5462
5463 ; # FOR !tc:ForAppendChild
5464
5465 ## -- Removes from parent
5466 if ($nc_parent) {
5467 if ($child_nt ==
5468 11
5469 ) {
5470 $$newChild->{
5471 'child'
5472 } = [];
5473 } else {
5474 my $v = $$nc_parent->{
5475 'child'
5476 };
5477 RP: for my $i (0..$#$v) {
5478 if ($v->[$i] eq $new_child[0]) {
5479 splice @$v, $i, 1, ();
5480 last RP;
5481 }
5482 } # RP
5483 }
5484 }
5485
5486 ## -- Rewrite the |parentNode| properties
5487 for my $nc (@new_child) {
5488 $$nc->{
5489 'parent'
5490 } = $self;
5491 Scalar::Util::weaken ($$nc->{
5492 'parent'
5493 });
5494 }
5495
5496 my $children = $$self->{
5497 'child'
5498 };
5499
5500
5501
5502 ;
5503
5504
5505
5506 {
5507
5508
5509 ## -- Adds to children list
5510 if ($index == -1) {
5511 push @$children, @new_child;
5512 } else {
5513 splice @$children, $index, 0, @new_child;
5514 }
5515 $r = $newChild;
5516
5517
5518
5519 }
5520
5521 ;
5522
5523
5524
5525 ;
5526
5527
5528
5529 }
5530
5531
5532 ;}
5533
5534 ;
5535
5536
5537 }
5538
5539 ;
5540
5541
5542 }
5543 $r}
5544 sub replace_child ($$$) {
5545 my ($self, $newChild, $oldChild) = @_;
5546 my $r;
5547
5548 {
5549
5550 my
5551 $self_od = $self->
5552 owner_document
5553 ;
5554 my $child_od = $newChild->
5555 owner_document
5556 ;
5557 my $child_nt = $newChild->
5558 node_type
5559 ;
5560
5561
5562 {
5563
5564
5565 {
5566
5567 local $Error::Depth = $Error::Depth + 1;
5568
5569 {
5570
5571
5572 my
5573 $strict = $self_od->
5574 strict_error_checking
5575 ;
5576
5577 ## -- Node Type check
5578 my @new_child;
5579 if ({
5580 3 => 1,
5581 5 => 1,
5582 }->{$child_nt}) {
5583 push @new_child, $newChild;
5584 } elsif ($child_nt ==
5585 11
5586 ) {
5587 for my $cn (@{$newChild->
5588 child_nodes
5589 }) {
5590 unless ({
5591 3 => 1,
5592 5 => 1,
5593 }->{$cn->
5594 node_type
5595 }) {
5596
5597
5598 {
5599
5600 local $Error::Depth = $Error::Depth - 1;
5601
5602 {
5603
5604 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' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/replaceChildImpl1', '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;
5605
5606
5607 }
5608
5609
5610 ;}
5611
5612 ;
5613 }
5614 push @new_child, $cn;
5615 }
5616 } else {
5617
5618
5619 {
5620
5621 local $Error::Depth = $Error::Depth - 1;
5622
5623 {
5624
5625 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' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/replaceChildImpl1', '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;
5626
5627
5628 }
5629
5630
5631 ;}
5632
5633 ;
5634 }
5635
5636 my $nc_parent = @new_child ? $new_child[0]->
5637 parent_node
5638 :
5639
5640 undef
5641 ;
5642 if ($strict) {
5643 ## -- Wrong-document check
5644 unless ($self_od eq $child_od) {
5645
5646
5647 {
5648
5649 local $Error::Depth = $Error::Depth - 1;
5650
5651 {
5652
5653 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' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/replaceChildImpl1', '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;
5654
5655
5656 }
5657
5658
5659 ;}
5660
5661 ;
5662 }
5663
5664 ## -- Read-onlyness check
5665 if ($self->
5666 manakai_read_only
5667 ) {
5668
5669
5670 {
5671
5672 local $Error::Depth = $Error::Depth - 1;
5673
5674 {
5675
5676 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' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/replaceChildImpl1';
5677
5678
5679 }
5680
5681
5682 ;}
5683
5684 ;
5685 }
5686 if (@new_child) {
5687 if ($nc_parent and
5688 $nc_parent->
5689 manakai_read_only
5690 ) {
5691
5692
5693 {
5694
5695 local $Error::Depth = $Error::Depth - 1;
5696
5697 {
5698
5699 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' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/replaceChildImpl1';
5700
5701
5702 }
5703
5704
5705 ;}
5706
5707 ;
5708 }
5709 }
5710 }
5711
5712 ## -- Insert at...
5713 my $index = -1; # last
5714
5715
5716 {
5717
5718
5719 # tc:ForAppendChild & tc:ForReplaceChild
5720 if (defined $oldChild) {
5721 if ($oldChild eq $newChild) {
5722
5723
5724 ;
5725
5726
5727 {
5728
5729
5730 {
5731
5732 local $Error::Depth = $Error::Depth - 1;
5733
5734 {
5735
5736 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' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/replaceChildImpl1';
5737
5738
5739 }
5740
5741
5742 ;}
5743
5744 ;
5745
5746
5747
5748 }
5749
5750 ;
5751 }
5752
5753 my $cns = $self->
5754 child_nodes
5755 ;
5756 my $cnsl = @$cns;
5757 C: {
5758 $index = 0;
5759 for my $i (0..($cnsl-1)) {
5760 my $cn = $cns->[$i];
5761 if ($cn eq $oldChild) {
5762 $index += $i;
5763 last C;
5764 } elsif ($cn eq $newChild) {
5765 $index = -1; # offset
5766 }
5767 }
5768
5769
5770 ;
5771
5772
5773 {
5774
5775
5776 {
5777
5778 local $Error::Depth = $Error::Depth - 1;
5779
5780 {
5781
5782 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' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/replaceChildImpl1', '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;
5783
5784
5785 }
5786
5787
5788 ;}
5789
5790 ;
5791
5792
5793
5794 }
5795
5796 ;
5797 } # C
5798 } else { # |oldChild| is not defined
5799
5800
5801 {
5802
5803
5804 {
5805
5806 local $Error::Depth = $Error::Depth - 1;
5807
5808 {
5809
5810 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' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/replaceChildImpl1', '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;
5811
5812
5813 }
5814
5815
5816 ;}
5817
5818 ;
5819
5820
5821
5822 }
5823
5824 ;
5825 }
5826
5827
5828
5829 }
5830
5831 ; # FOR !tc:ForAppendChild
5832
5833 ## -- Removes from parent
5834 if ($nc_parent) {
5835 if ($child_nt ==
5836 11
5837 ) {
5838 $$newChild->{
5839 'child'
5840 } = [];
5841 } else {
5842 my $v = $$nc_parent->{
5843 'child'
5844 };
5845 RP: for my $i (0..$#$v) {
5846 if ($v->[$i] eq $new_child[0]) {
5847 splice @$v, $i, 1, ();
5848 last RP;
5849 }
5850 } # RP
5851 }
5852 }
5853
5854 ## -- Rewrite the |parentNode| properties
5855 for my $nc (@new_child) {
5856 $$nc->{
5857 'parent'
5858 } = $self;
5859 Scalar::Util::weaken ($$nc->{
5860 'parent'
5861 });
5862 }
5863
5864 my $children = $$self->{
5865 'child'
5866 };
5867
5868
5869
5870 ;
5871
5872
5873
5874 ;
5875
5876
5877
5878 {
5879
5880
5881 ## -- Replaces the node
5882 splice @$children, $index, 1, @new_child;
5883 CORE::delete $$oldChild->{
5884 'parent'
5885 };
5886 $r = $oldChild;
5887
5888
5889
5890 }
5891
5892 ;
5893
5894
5895
5896 }
5897
5898
5899 ;}
5900
5901 ;
5902
5903
5904 }
5905
5906 ;
5907
5908
5909 }
5910 $r}
5911 sub node_name ($;$) {
5912 if (@_ == 1) {my ($self) = @_;
5913 my $r = '';
5914
5915 {
5916
5917 my
5918 $prefix = $$self->{
5919 'pfx'
5920 };
5921 my $lname = $$self->{
5922 'ln'
5923 };
5924 $r = defined $prefix ? $$prefix.':'.$$lname : $$lname;
5925
5926
5927 }
5928 $r;
5929 } else {my ($self) = @_;
5930 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';
5931 }
5932 }
5933 sub name ($;$) {
5934 if (@_ == 1) {my ($self) = @_;
5935 my $r = '';
5936
5937 {
5938
5939 my
5940 $prefix = $$self->{
5941 'pfx'
5942 };
5943 my $lname = $$self->{
5944 'ln'
5945 };
5946 $r = defined $prefix ? $$prefix.':'.$$lname : $$lname;
5947
5948
5949 }
5950 $r;
5951 } else {my ($self) = @_;
5952 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';
5953 }
5954 }
5955 sub node_value ($;$) {
5956 if (@_ == 1) {my ($self) = @_;
5957 my $r = '';
5958
5959 {
5960
5961
5962 {
5963
5964 local $Error::Depth = $Error::Depth + 1;
5965
5966 {
5967
5968
5969
5970 $r = '';
5971 for my $child (@{$self->
5972 child_nodes
5973 }) {
5974 if ($child->
5975 node_type
5976 ==
5977
5978 5
5979 ) {
5980 my $v = $child->
5981 text_content
5982 ;
5983 $v =~ s/[\x09\x0A\x0D]/ /;
5984 $r .= $v;
5985 } else {
5986 $r .= $child->
5987 text_content
5988 ;
5989 }
5990 } # childNodes
5991 my $vt = $$self->{
5992 'at'
5993 };
5994 unless (not defined $vt or
5995 $vt ==
5996 0 or
5997
5998 $vt ==
5999 11 or
6000
6001 $vt ==
6002 1
6003 ) {
6004 $r =~ s/\A\x20+//;
6005 $r =~ s/\x20+\z//;
6006 $r =~ s/\x20+/ /g;
6007 }
6008
6009 if (defined $vt and $vt ==
6010 2 and
6011
6012 $self->
6013 owner_document
6014 ->
6015 dom_config
6016
6017 ->
6018 get_parameter
6019 (
6020 'http://suika.fam.cx/www/2006/dom-config/xml-id'
6021 )) {
6022 $r =~ s/[\x09\x0A\x0D\x20]+/ /g;
6023 $r =~ s/\A //;
6024 $r =~ s/ \z//;
6025 }
6026
6027
6028
6029 }
6030
6031
6032 ;}
6033
6034 ;
6035
6036
6037 }
6038 $r;
6039 } else {my ($self, $given) = @_;
6040
6041 {
6042
6043
6044 {
6045
6046
6047 {
6048
6049 if
6050 ($self->
6051 manakai_read_only
6052 ) {
6053
6054 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' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/NodeReadOnlyError';
6055
6056 ;
6057 }
6058
6059
6060 }
6061
6062 ;
6063
6064 for my $__old_child (@{${$self}->{
6065 'child'
6066 }}) {
6067 CORE::delete $$__old_child->{
6068 'parent'
6069 };
6070 }
6071
6072 my @__new_children;
6073 if (defined $given and length $given) {
6074 my $__text = $self->owner_document->
6075 create_text_node
6076 ($given);
6077 push @__new_children, $__text;
6078 $$__text->{
6079 'parent'
6080 } = $self;
6081 Scalar::Util::weaken ($$__text->{
6082 'parent'
6083 });
6084 }
6085
6086 ${$self}->{
6087 'child'
6088 } = \@__new_children;
6089
6090
6091 }
6092
6093 ;
6094
6095
6096 }
6097 }
6098 }
6099 sub manakai_append_text ($$) {
6100 my ($self, $string) = @_;
6101 my $r;
6102
6103 {
6104
6105
6106 {
6107
6108 local $Error::Depth = $Error::Depth + 1;
6109
6110 {
6111
6112
6113 my
6114 $lc = $self->
6115 last_child
6116 ;
6117 if (defined $lc and
6118 $lc->
6119 node_type
6120 ==
6121 3
6122 ) {
6123 $lc->
6124 manakai_append_text
6125
6126 (ref $string eq 'SCALAR' ? $string : \$string);
6127 } else {
6128 my $text = $self->
6129 owner_document
6130
6131 ->
6132 create_text_node
6133
6134 (ref $string eq 'SCALAR' ? $$string : $string);
6135 $self->
6136 append_child
6137 ($text);
6138 }
6139 $r = $self;
6140
6141
6142
6143 }
6144
6145
6146 ;}
6147
6148 ;
6149
6150
6151 }
6152 $r}
6153 sub get_feature ($$$) {
6154 my ($self, $feature, $version) = @_;
6155
6156 {
6157
6158
6159 $feature = lc $feature;
6160
6161
6162 }
6163
6164 {
6165
6166
6167 $version = '' unless defined $version;
6168
6169
6170 }
6171 my $r;
6172
6173 {
6174
6175
6176 $feature =~ s/^\+//;
6177
6178
6179 {
6180
6181 if
6182 ($Message::Util::AutoLoad::Registry::Feature->{$feature}->{$version}) {
6183 $r = $self;
6184 }
6185
6186
6187 }
6188
6189 ;
6190 unless (defined $r) {
6191
6192
6193 {
6194
6195 local $Error::Depth = $Error::Depth + 1;
6196
6197 {
6198
6199
6200
6201 $r = $self->SUPER::get_feature ($feature, $version);
6202
6203
6204
6205 }
6206
6207
6208 ;}
6209
6210 ;
6211 }
6212
6213
6214 }
6215 $r}
6216 sub base_uri ($;$) {
6217 if (@_ == 1) {my ($self) = @_;
6218 my $r = '';
6219
6220 {
6221
6222
6223 {
6224
6225 local $Error::Depth = $Error::Depth + 1;
6226
6227 {
6228
6229
6230 my
6231 $oe = $self->
6232 owner_element
6233 ;
6234 if ($oe) {
6235 my $ln = $self->local_name;
6236 my $nsuri = $self->namespace_uri;
6237 if (($ln eq 'base' and defined $nsuri and $nsuri eq
6238 'http://www.w3.org/XML/1998/namespace'
6239 ) or
6240 ($ln eq 'xml:base' and not defined $nsuri)) {
6241 my $oep = $oe->
6242 parent_node
6243 ;
6244 if ($oep) {
6245 $r = $oep->
6246 base_uri
6247 ;
6248 } else {
6249 $r = $self->
6250 owner_document
6251 ->
6252 base_uri
6253 ;
6254 }
6255 } else {
6256 $r = $oe->
6257 base_uri
6258 ;
6259 }
6260 } else {
6261 $r = $self->
6262 owner_document
6263 ->
6264 base_uri
6265 ;
6266 }
6267
6268
6269
6270 }
6271
6272
6273 ;}
6274
6275 ;
6276
6277
6278 }
6279 $r;
6280 } else {my ($self) = @_;
6281 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';
6282 }
6283 }
6284 sub owner_element ($;$) {
6285 if (@_ == 1) {my ($self) = @_;
6286 my $r;
6287
6288 {
6289
6290
6291 $r = $$self->{
6292 'owner'
6293 };
6294
6295
6296 }
6297 $r;
6298 } else {my ($self) = @_;
6299 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';
6300 }
6301 }
6302 sub specified ($;$) {
6303 if (@_ == 1) {my ($self) = @_;
6304 my $r = 0;
6305
6306 {
6307
6308
6309 $r = $$self->{
6310 'specified'
6311 };
6312 unless ($r) {
6313 unless (defined $$self->{
6314 'owner'
6315 }) {
6316 $r =
6317 1
6318 ;
6319 }
6320 }
6321
6322
6323 }
6324 $r;
6325 } else {my ($self, $given) = @_;
6326
6327 {
6328
6329
6330 {
6331
6332 if
6333 ($self->
6334 manakai_read_only
6335 ) {
6336
6337 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' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/NodeReadOnlyError';
6338
6339 ;
6340 }
6341
6342
6343 }
6344
6345 ;
6346 unless ($given) {
6347 $given = 1 unless defined $$self->{
6348 'owner'
6349 };
6350 }
6351 $$self->{
6352 'specified'
6353 } = $given;
6354
6355
6356 }
6357 }
6358 }
6359 sub value ($;$) {
6360 if (@_ == 1) {my ($self) = @_;
6361 my $r = '';
6362
6363 {
6364
6365
6366 {
6367
6368 local $Error::Depth = $Error::Depth + 1;
6369
6370 {
6371
6372
6373
6374 $r = '';
6375 for my $child (@{$self->
6376 child_nodes
6377 }) {
6378 if ($child->
6379 node_type
6380 ==
6381
6382 5
6383 ) {
6384 my $v = $child->
6385 text_content
6386 ;
6387 $v =~ s/[\x09\x0A\x0D]/ /;
6388 $r .= $v;
6389 } else {
6390 $r .= $child->
6391 text_content
6392 ;
6393 }
6394 } # childNodes
6395 my $vt = $$self->{
6396 'at'
6397 };
6398 unless (not defined $vt or
6399 $vt ==
6400 0 or
6401
6402 $vt ==
6403 11 or
6404
6405 $vt ==
6406 1
6407 ) {
6408 $r =~ s/\A\x20+//;
6409 $r =~ s/\x20+\z//;
6410 $r =~ s/\x20+/ /g;
6411 }
6412
6413 if (defined $vt and $vt ==
6414 2 and
6415
6416 $self->
6417 owner_document
6418 ->
6419 dom_config
6420
6421 ->
6422 get_parameter
6423 (
6424 'http://suika.fam.cx/www/2006/dom-config/xml-id'
6425 )) {
6426 $r =~ s/[\x09\x0A\x0D\x20]+/ /g;
6427 $r =~ s/\A //;
6428 $r =~ s/ \z//;
6429 }
6430
6431
6432
6433 }
6434
6435
6436 ;}
6437
6438 ;
6439
6440
6441 }
6442 $r;
6443 } else {my ($self, $given) = @_;
6444
6445 {
6446
6447
6448 {
6449
6450
6451 {
6452
6453 if
6454 ($self->
6455 manakai_read_only
6456 ) {
6457
6458 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' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/NodeReadOnlyError';
6459
6460 ;
6461 }
6462
6463
6464 }
6465
6466 ;
6467
6468 for my $__old_child (@{${$self}->{
6469 'child'
6470 }}) {
6471 CORE::delete $$__old_child->{
6472 'parent'
6473 };
6474 }
6475
6476 my @__new_children;
6477 if (defined $given and length $given) {
6478 my $__text = $self->owner_document->
6479 create_text_node
6480 ($given);
6481 push @__new_children, $__text;
6482 $$__text->{
6483 'parent'
6484 } = $self;
6485 Scalar::Util::weaken ($$__text->{
6486 'parent'
6487 });
6488 }
6489
6490 ${$self}->{
6491 'child'
6492 } = \@__new_children;
6493
6494
6495 }
6496
6497 ;
6498
6499
6500 }
6501 }
6502 }
6503 sub schema_type_info ($;$) {
6504 if (@_ == 1) {my ($self) = @_;
6505 my $r;
6506
6507 {
6508
6509 my
6510 $type = $$self->{
6511 'at'
6512 };
6513
6514
6515 {
6516
6517 my
6518 $v = $type || 0;
6519 $r = bless \$v,
6520 'Message::DOM::Element::ManakaiDOMDTDTypeInfo'
6521 ;
6522
6523
6524 }
6525
6526 ;
6527
6528
6529 }
6530 $r;
6531 } else {my ($self) = @_;
6532 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';
6533 }
6534 }
6535 sub is_id ($;$) {
6536 if (@_ == 1) {my ($self) = @_;
6537 my $r = 0;
6538
6539 {
6540
6541 T:
6542 {
6543 ## DTD Attribute Type
6544 my $type = $$self->{
6545 'at'
6546 };
6547 if (defined $type and $type ==
6548 2
6549 ) {
6550 $r =
6551 1
6552 ;
6553 last T;
6554 }
6555
6556 ## User-determined ID
6557 my $udid = $$self->{
6558 'isudid'
6559 };
6560 if ($udid) {
6561 $r =
6562 1
6563 ;
6564 last T;
6565 }
6566
6567 ## Application-determined ID
6568 my $nsuri = $self->
6569 namespace_uri
6570 ;
6571 my $ln = $self->
6572 local_name
6573 ;
6574 if (defined $nsuri and $nsuri eq
6575 'http://www.w3.org/XML/1998/namespace' and
6576
6577 $ln eq 'id') {
6578 $r =
6579 1
6580 ;
6581 last T;
6582 } elsif (not defined $nsuri and $ln eq 'xml:id') {
6583 $r =
6584 1
6585 ;
6586 last T;
6587 }
6588 } # T
6589
6590
6591 }
6592 $r;
6593 } else {my ($self, $given) = @_;
6594
6595 {
6596
6597
6598 {
6599
6600 if
6601 ($self->
6602 manakai_read_only
6603 ) {
6604
6605 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' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/NodeReadOnlyError';
6606
6607 ;
6608 }
6609
6610
6611 }
6612
6613 ;
6614 $$self->{
6615 'isudid'
6616 } = $given;
6617
6618
6619 }
6620 }
6621 }
6622 sub manakai_attribute_type ($;$) {
6623 if (@_ == 1) {my ($self) = @_;
6624 my $r = 0;
6625
6626 {
6627
6628
6629 $r = $$self->{
6630 'at'
6631 };
6632 $r =
6633 0 unless
6634 defined $r;
6635
6636
6637 }
6638 $r;
6639 } else {my ($self, $given) = @_;
6640
6641 {
6642
6643
6644 {
6645
6646 if
6647 ($self->
6648 manakai_read_only
6649 ) {
6650
6651 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' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/NodeReadOnlyError';
6652
6653 ;
6654 }
6655
6656
6657 }
6658
6659 ;
6660 $$self->{
6661 'at'
6662 } = $given;
6663
6664
6665 }
6666 }
6667 }
6668 $Message::DOM::DOMFeature::ClassInfo->{q<Message::DOM::Element::ManakaiDOMAttr>}->{has_feature} = {'core',
6669 {'',
6670 '1',
6671 '1.0',
6672 '1',
6673 '2.0',
6674 '1',
6675 '3.0',
6676 '1'},
6677 'xml',
6678 {'',
6679 '1',
6680 '1.0',
6681 '1',
6682 '2.0',
6683 '1',
6684 '3.0',
6685 '1'},
6686 'xmlversion',
6687 {'',
6688 '1',
6689 '1.0',
6690 '1',
6691 '1.1',
6692 '1'}};
6693 $Message::DOM::ClassPoint{q<Message::DOM::Element::ManakaiDOMAttr>} = 14.1;
6694 package Message::DOM::IF::TypeInfo;
6695 our $VERSION = 20061231.0208;
6696 sub DERIVATION_RESTRICTION () {
6697 1}
6698 sub DERIVATION_EXTENSION () {
6699 2}
6700 sub DERIVATION_UNION () {
6701 4}
6702 sub DERIVATION_LIST () {
6703 8}
6704 package Message::DOM::Element::ManakaiDOMDTDTypeInfo;
6705 our $VERSION = 20061231.0208;
6706 push our @ISA, 'Message::DOM::IF::TypeInfo';
6707 sub type_name ($;$) {
6708 if (@_ == 1) {my ($self) = @_;
6709 my $r = '';
6710
6711 {
6712
6713
6714 $r = {
6715
6716 1
6717 => 'CDATA',
6718
6719 2
6720 => 'ID',
6721
6722 3
6723 => 'IDREF',
6724
6725 4
6726 => 'IDREFS',
6727
6728 5
6729 => 'ENTITY',
6730
6731 6
6732 => 'ENTITIES',
6733
6734 7
6735 => 'NMTOKEN',
6736
6737 8
6738 => 'NMTOKENS',
6739
6740 9
6741 => 'NOTATION',
6742
6743 10
6744 => 'ENUMERATION',
6745 }->{$$self};
6746
6747
6748 }
6749 $r;
6750 } else {my ($self) = @_;
6751 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';
6752 }
6753 }
6754 sub type_namespace ($;$) {
6755 if (@_ == 1) {my ($self) = @_;
6756 my $r = '';
6757
6758 {
6759
6760
6761 $r = {
6762
6763 1
6764 =>
6765 1
6766 ,
6767
6768 2
6769 =>
6770 1
6771 ,
6772
6773 3
6774 =>
6775 1
6776 ,
6777
6778 4
6779 =>
6780 1
6781 ,
6782
6783 5
6784 =>
6785 1
6786 ,
6787
6788 6
6789 =>
6790 1
6791 ,
6792
6793 7
6794 =>
6795 1
6796 ,
6797
6798 8
6799 =>
6800 1
6801 ,
6802
6803 9
6804 =>
6805 1
6806 ,
6807
6808 10
6809 =>
6810 1
6811 ,
6812 }->{$$self} ?
6813 'http://www.w3.org/TR/REC-xml' :
6814 undef;
6815
6816
6817 }
6818 $r;
6819 } else {my ($self) = @_;
6820 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';
6821 }
6822 }
6823 sub is_derived_from ($$$$) {
6824 my ($self, $typeNamespaceArg, $typeNameArg, $derivationMethod) = @_;
6825 my $r = 0;
6826
6827
6828 $r}
6829 use overload
6830 bool => sub () {1},
6831 'eq' => sub ($$) {
6832 my ($self, $t) = @_;
6833 my $r = 0;
6834
6835 {
6836
6837
6838 {
6839
6840 local $Error::Depth = $Error::Depth + 1;
6841
6842 {
6843
6844
6845 if
6846 (UNIVERSAL::isa ($t,
6847 'Message::DOM::IF::TypeInfo'
6848 )) {
6849 my $ln1 = $self->
6850 type_name
6851 ;
6852 my $ln2 = $t->
6853 type_name
6854 ;
6855 if ((defined $ln1 and defined $ln2 and $ln1 eq $ln2) or
6856 (not defined $ln1 or not defined $ln2)) {
6857 my $ns1 = $self->
6858 type_namespace
6859 ;
6860 my $ns2 = $t->
6861 type_namespace
6862 ;
6863 if ((defined $ns1 and defined $ns2 and $ns1 eq $ns2) or
6864 (not defined $ns1 and not defined $ns2)) {
6865 $r =
6866 1
6867 ;
6868 }
6869 }
6870 }
6871
6872
6873
6874 }
6875
6876
6877 ;}
6878
6879 ;
6880
6881
6882 }
6883 $r}
6884 ,
6885 fallback => 1;
6886 $Message::DOM::DOMFeature::ClassInfo->{q<Message::DOM::Element::ManakaiDOMDTDTypeInfo>}->{has_feature} = {'core',
6887 {'',
6888 '1',
6889 '3.0',
6890 '1'},
6891 'xml',
6892 {'',
6893 '1',
6894 '3.0',
6895 '1'},
6896 'xmlversion',
6897 {'',
6898 '1',
6899 '1.0',
6900 '1',
6901 '1.1',
6902 '1'}};
6903 $Message::DOM::ClassPoint{q<Message::DOM::Element::ManakaiDOMDTDTypeInfo>} = 8.1;
6904 for ($Message::DOM::IF::Node::){}
6905 ## License: <http://suika.fam.cx/~wakaba/archive/2004/8/18/license#Perl+MPL>
6906 1;
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24