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

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

Parent Directory Parent Directory | Revision Log Revision Log


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

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

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

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

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

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

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

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

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

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

	* daf-perl-t.pl: Use |create_pc_document|
	instead of |create_pc_file|.
	(daf_generate_perl_test_file|: Removed.
	(daf_generate_perl_test_document|: New function.

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

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24