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