/[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.14 - (hide annotations) (download)
Sat Dec 30 04:42:51 2006 UTC (17 years, 10 months ago) by wakaba
Branch: MAIN
Changes since 1.13: +25 -46 lines
++ manakai/lib/Message/Markup/ChangeLog	30 Dec 2006 04:39:04 -0000
2006-12-30  Wakaba  <wakaba@suika.fam.cx>

	* Atom.dis, SuikaWiki.dis: References
	to the |ManakaiDOM:ManakaiDOM| mode are removed.

++ manakai/lib/Message/Util/ChangeLog	30 Dec 2006 04:39:32 -0000
	* DIS.dis, PerlCode.dis: References to the |ManakaiDOM:ManakaiDOM|
	mode are removed.

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

++ manakai/lib/Message/Util/DIS/ChangeLog	30 Dec 2006 04:42:43 -0000
	* DPG.dis, Perl.dis, Value.dis, Test.dis: References
	to |ManakaiDOM:ManakaiDOM| modes are removed.

	* Perl.dis (plCodeFragment): |local|ize
	the |DIS:plCodeFragment| cache to avoid
	ancestor nodes of the cached fragment
	are destroyed so that the cached nodes
	become invalid.

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

++ manakai/lib/Message/DOM/ChangeLog	30 Dec 2006 04:37:29 -0000
	* CharacterData.dis, DOMCore.dis, DOMFeature.dis,
	GenericLS.dis, TreeCore.dis, DOMString.dis,
	XML.dis, Element.dis, Document.dis, TreeStore,dis,
	Traversal.dis, XDoctype.dis, XMLParser.dis, DOMLS.dis,
	SimpleLS.dis, DOMMain.dis: References
	to the |ManakaiDOM:ManakaiDOM|, |ManakaiDOM:ManakaiDOM1|,
	|ManakaiDOM:ManakaiDOM2|, and |ManakaiDOM:ManakaiDOM3|
	modes are removed.

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

++ manakai/lib/Message/URI/ChangeLog	30 Dec 2006 04:35:39 -0000
2006-12-30  Wakaba  <wakaba@suika.fam.cx>

	* Generic.dis (Require): Reference to the |ManakaiDOM:ManakaiDOM|
	mode is removed.

++ manakai/lib/Message/Charset/ChangeLog	30 Dec 2006 04:35:23 -0000
2006-12-30  Wakaba  <wakaba@suika.fam.cx>

	* Encode.dis (Require): Reference to the |ManakaiDOM:ManakaiDOM|
	mode is removed.

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

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24