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

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

Parent Directory Parent Directory | Revision Log Revision Log


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

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

	* TreeCore.dis (AttrMap.item): Caches the result
	of sorting of content attribute names.
	(getAttrMap, getElementTypeDefNodeMap,
	getAttrDefNodeMap, getEntityNodeMap, getNotationNodeMap): Removed.
	(tc:contentAttributeList): New property.

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

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24