/[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.19 - (hide annotations) (download)
Sun Dec 31 09:11:53 2006 UTC (17 years, 10 months ago) by wakaba
Branch: MAIN
Changes since 1.18: +20 -29 lines
++ manakai/bin/ChangeLog	31 Dec 2006 08:49:16 -0000
2006-12-31  Wakaba  <wakaba@suika.fam.cx>

	* daf.pl: Support for |For| is entirely removed.

++ manakai/lib/Message/Util/ChangeLog	31 Dec 2006 09:06:08 -0000
	* DIS.dis: Support for |for| is entirely removed.  |forArg|
	parameters are removed.
	(createDISDocument): Removed.
	(tfurisToURI): Removed.
	(tfpurisToURI): The |for| URI slot is
	fixed to |ManakaiDOM:all|.
	(tfqnamesToURI): Removed.
	(tfpqnamesToURI): The |defaultForURI| parameter
	is removed and the |for| URI slot is
	fixed to |ManakaiDOM:all|.
	(forURI): Removed.
	(forMatch): The first parameter, |forArg|, no
	longer takes effect.

	* PerlCode.dis (sourceFor): Removed.
	(stringify): Don't output comment with |sourceFor| URI.

2006-12-31  Wakaba  <wakaba@suika.fam.cx>

++ manakai/lib/Message/Util/Error/ChangeLog	31 Dec 2006 09:09:24 -0000
2006-12-31  Wakaba  <wakaba@suika.fam.cx>

	* Core.dis, DOMException.dis: |dis:dataType|
	of |DISCore:TFQNames| are replaced
	by |DISCore:QName|.

++ manakai/lib/Message/Util/DIS/ChangeLog	31 Dec 2006 09:08:40 -0000
	* DNLite.dis, Perl.dis: Support for |for| is entirely removed.

	* Test.dis (parseTDTErrorString): The |defaultTURI|
	and |defaultFURI| parameters are removed.
	(lexmode): |TFQNames| token type is removed.
	(tdterr): Accepts |QName| where |TFQNames| was accepted.

2006-12-31  Wakaba  <wakaba@suika.fam.cx>

++ manakai/lib/Message/DOM/ChangeLog	31 Dec 2006 08:50:54 -0000
	* |InputProcessor|s and |OutputProcessor|s are
	named so that |report| statements in Perl
	module outputs can be identified by name. |dis:dataType|s
	of |DISCore:TFQNames| are all replaced
	by |DISCore:QName|.

2006-12-31  Wakaba  <wakaba@suika.fam.cx>

++ manakai/lib/manakai/ChangeLog	31 Dec 2006 09:11:27 -0000
	* |dis:dataType| of |DISCore:TFQNames| are replaced
	by |DISCore:QName|.

	* DISCore.dis (DISCore:TFURI): Removed.
	(DISCore:ModuleTFQNames): Removed.

	* daf-dtd-modules.pl: Support for |for| is removed.

2006-12-31  Wakaba  <wakaba@suika.fam.cx>

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

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24