/[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.13 - (show annotations) (download)
Fri Dec 29 14:45:41 2006 UTC (17 years, 10 months ago) by wakaba
Branch: MAIN
Changes since 1.12: +564 -2466 lines 
++ manakai/t/ChangeLog	29 Dec 2006 13:56:36 -0000
2006-12-29  Wakaba  <wakaba@suika.fam.cx>

	* .cvsignore: New auto-generated Perl test files
	are added.

++ manakai/lib/Message/Util/ChangeLog	29 Dec 2006 13:53:51 -0000
2006-12-29  Wakaba  <wakaba@suika.fam.cx>

	* PerlCode.dis (createPCFile): Removed.
	(createPCDocument): New method.

++ manakai/lib/Message/Util/DIS/ChangeLog	29 Dec 2006 13:54:30 -0000
2006-12-29  Wakaba  <wakaba@suika.fam.cx>

	* Perl.dis (plGeneratePerlModuleFile): Removed.
	(plGeneratePerlModuleDocument): New method.

++ manakai/lib/Message/DOM/ChangeLog	29 Dec 2006 13:53:21 -0000
2006-12-29  Wakaba  <wakaba@suika.fam.cx>

	* TreeCore.dis, DOMCore.dis, Document.dis,
	Element.dis, CharacterData.dis, XML.dis,
	XDoctype.dis, DOMString.dis, TreeStore.dis,
	XMLParser.dis: Use Perl native
	hashs and |Scalar::Util|'s weak references in favor of |Grove.dis|
	for DOM nodes.  See
	also <http://suika.fam.cx/gate/2005/sw/manakai/%E3%83%A1%E3%83%A2/2006-12-29>.

++ manakai/lib/manakai/ChangeLog	29 Dec 2006 13:56:06 -0000
2006-12-29  Wakaba  <wakaba@suika.fam.cx>

	* daf-perl-pm.pl: Use |pl_generate_perl_module_document|
	instead of |pl_generate_perl_module_file|.

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