/[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.12 - (hide annotations) (download)
Sun Dec 3 05:40:33 2006 UTC (17 years, 11 months ago) by wakaba
Branch: MAIN
CVS Tags: manakai-200612
Changes since 1.11: +18 -19 lines
++ manakai/lib/Message/Util/DIS/ChangeLog	3 Dec 2006 05:40:22 -0000
2006-12-03  Wakaba  <wakaba@suika.fam.cx>

	* Perl.dis: Support for obsolete |role|s is removed.

++ manakai/lib/Message/DOM/ChangeLog	3 Dec 2006 05:39:22 -0000
2006-12-03  Wakaba  <wakaba@suika.fam.cx>

	* DOMFeature.dis, TreeCore.dis: Unused |role|s are removed.

1 wakaba 1.1 #!/usr/bin/perl
2     ## This file is automatically generated
3 wakaba 1.12 ## at 2006-12-03T04:32:02+00:00,
4 wakaba 1.7 ## from file "Element.dis",
5 wakaba 1.1 ## module <http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#ManakaiDOM.Element>,
6     ## for <http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#ManakaiDOMLatest>.
7     ## Don't edit by hand!
8     use strict;
9     require Message::DOM::DOMCore;
10 wakaba 1.9 require Message::DOM::Document;
11 wakaba 1.1 require Message::DOM::TreeCore;
12     require Message::Util::Error::DOMException;
13     package Message::DOM::Element;
14 wakaba 1.12 our $VERSION = 20061203.0432;
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.12 our $VERSION = 20061203.0432;
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.12 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:1165118814:1861:wAUT122229+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     my $bag =
337     $self->{'b'}
338     ;
339     my $stem;
340    
341    
342     {
343    
344    
345     $stem = 'Message::DOM::Element::ManakaiDOMElement'->___create_node_stem ($bag, {
346    
347     'rc'
348     => 0,
349    
350     'id'
351     => \
352     (
353     'tag:suika.fam.cx,2005-09:' . time . ':' . $$ . ':' .
354     (++$Message::Util::ManakaiNode::UniqueIDN)
355     )
356     ,
357     }, {
358     'od' => $self,
359     'ns' => \$namespaceURI,
360     'pfx' => \$prefix,
361     'ln' => \$lname,
362     });
363    
364    
365     {
366    
367     if
368     (defined 'Message::DOM::Element::ManakaiDOMElement') {
369     if (ref 'Message::DOM::Element::ManakaiDOMElement' eq 'SCALAR') {
370     $stem->{'cls'} = 'Message::DOM::Element::ManakaiDOMElement';
371     } elsif (defined $Message::Util::ManakaiStringRef::Value{'Message::DOM::Element::ManakaiDOMElement'}) {
372     $stem->{'cls'} = $Message::Util::ManakaiStringRef::Value{'Message::DOM::Element::ManakaiDOMElement'};
373     } else {
374     require Scalar::Util;
375     $stem->{'cls'} = $Message::Util::ManakaiStringRef::Value{'Message::DOM::Element::ManakaiDOMElement'} = \('Message::DOM::Element::ManakaiDOMElement');
376     Scalar::Util::weaken ($Message::Util::ManakaiStringRef::Value{'Message::DOM::Element::ManakaiDOMElement'});
377     }
378     } else {
379     CORE::delete $stem->{'cls'};
380     }
381    
382    
383     }
384    
385     ;
386     $bag->{${$stem->{
387     'id'
388     }}} = $stem;
389    
390    
391     }
392    
393     ;
394    
395    
396     {
397    
398    
399     $r = ${$stem->{
400     'cls'
401     }}->___create_node_ref ({
402    
403     'id'
404     => $stem->{
405     'id'
406     },
407    
408     'b'
409     => $bag,
410     }, {
411     });
412     $stem->{
413     'rc'
414     }++;
415    
416    
417     }
418    
419     ;
420    
421     ## Default attributes
422    
423    
424     {
425    
426    
427     {
428    
429     local $Error::Depth = $Error::Depth + 1;
430    
431     {
432    
433    
434     XDA:
435     {
436     my $__cfg = $self->
437     dom_config
438     ;
439     last XDA unless $__cfg->
440     get_parameter
441    
442     (
443     'http://suika.fam.cx/www/2006/dom-config/dtd-default-attribute'
444     );
445     my $__doctype = $self->
446     doctype
447     ;
448     last XDA unless defined $__doctype;
449     $__doctype = $__doctype->
450     get_feature
451    
452     (
453     'http://suika.fam.cx/www/2006/feature/XDoctype'
454     => '3.0');
455     last XDA unless defined $__doctype;
456     my $__et = $__doctype->
457     get_element_type_definition_node
458    
459     ($qualifiedName);
460     if ($__et) {
461     my $__orig_strict = $self->
462     strict_error_checking
463     ;
464     $self->
465     strict_error_checking
466     (
467     0
468     );
469     my %__gattr;
470     my %__has_attr;
471     my %__pfx_to_uri;
472     my $__copy_asis = $__cfg->
473     get_parameter
474    
475     (
476     'http://suika.fam.cx/www/2006/dom-config/clone-entity-reference-subtree'
477     );
478     $__cfg->
479     set_parameter
480    
481     (
482     'http://suika.fam.cx/www/2006/dom-config/clone-entity-reference-subtree'
483     =>
484     1
485     );
486     for my $__at (@{$__et->
487     attribute_definitions
488     }) {
489     my $__at_default = $__at->
490     default_type
491     ;
492     if ($__at_default ==
493     4 or
494    
495     $__at_default ==
496     1
497     ) {
498     my ($__nn1, $__nn2) = split /:/, $__at->
499     node_name
500     ;
501     if (defined $__nn2) { # prefixed
502     if ($__nn1 eq 'xmlns') {
503     ## TODO: NCName check, prefix check and NSURI check
504     my $__attr = $self->
505     create_attribute_ns
506    
507     (
508     'http://www.w3.org/2000/xmlns/'
509     , [$__nn1, $__nn2]);
510     for my $__at_child (@{$__at->
511     child_nodes
512     }) {
513     $__attr->
514     append_child
515    
516     ($__at_child->
517     clone_node
518     (
519     1
520     ));
521     }
522     $__attr->
523     manakai_attribute_type
524    
525     ($__at->
526     declared_type
527     );
528     my $__nsuri = $__attr->
529     value
530     ;
531     ## TODO: Namespace well-formedness check (NSURI), v1.1 chk
532     $__pfx_to_uri{$__nn2} = $__nsuri;
533     $r->
534     set_attribute_node_ns
535     ($__attr);
536     ## This method changes |specified| flag
537     $__attr->
538     specified
539     (
540     0
541     );
542     $__has_attr{
543     'http://www.w3.org/2000/xmlns/'
544     }->{$__nn2} =
545     1
546     ;
547     } else {
548     ## TODO: NCName check
549     $__gattr{$__nn1}->{$__nn2} = $__at;
550     }
551     } else { # no prefixed
552     my $__attr;
553     if ($__nn1 eq 'xmlns') {
554     $__attr = $self->
555     create_attribute_ns
556    
557     (
558     'http://www.w3.org/2000/xmlns/'
559     , 'xmlns');
560     $__has_attr{
561     'http://www.w3.org/2000/xmlns/'
562     }->{xmlns} =
563     1
564     ;
565     } else {
566     $__attr = $self->
567     create_attribute_ns
568    
569     (
570     undef
571     , $__nn1);
572     ## TODO: NCName check
573     }
574     for my $__at_child (@{$__at->
575     child_nodes
576     }) {
577     $__attr->
578     append_child
579    
580     ($__at_child->
581     clone_node
582     (
583     1
584     ));
585     }
586     $__attr->
587     manakai_attribute_type
588    
589     ($__at->
590     declared_type
591     );
592     ## TODO: Namespace well-formedness check (NSURI)
593     $r->
594     set_attribute_node_ns
595     ($__attr);
596     ## This method changes |specified| flag
597     $__attr->
598     specified
599     (
600     0
601     );
602     }
603     }
604     } # attrdefs
605     for my $__pfx (keys %__gattr) {
606     my $__nsuri = $__pfx_to_uri{$__pfx};
607     unless (defined $__nsuri) {
608     ## TODO: Namespace well-formedness error
609     }
610     LN: for my $__ln (keys %{$__gattr{$__pfx}}) {
611     if ($__has_attr{defined $__nsuri ? $__nsuri : ''}->{$__ln}) {
612     ## TODO: Namespace well-formedness error
613     next LN;
614     }
615     ## TODO: NCName check, prefix check and NSURI check
616     my $__at = $__gattr{$__pfx}->{$__ln};
617     my $__attr = $self->
618     create_attribute_ns
619    
620     ($__nsuri, [$__pfx, $__ln]);
621     for my $__at_child (@{$__at->
622     child_nodes
623     }) {
624     $__attr->
625     append_child
626    
627     ($__at_child->
628     clone_node
629     (
630     1
631     ));
632     }
633     $__attr->
634     manakai_attribute_type
635    
636     ($__at->
637     declared_type
638     );
639     $r->
640     set_attribute_node_ns
641     ($__attr);
642     ## This method changes |specified| flag
643     $__attr->
644     specified
645     (
646     0
647     );
648     $__has_attr{defined $__nsuri ? $__nsuri : ''}->{$__ln} =
649     1
650     ;
651     } # LN
652     } # pfx
653     $__cfg->
654     set_parameter
655    
656     (
657     'http://suika.fam.cx/www/2006/dom-config/clone-entity-reference-subtree'
658     => $__copy_asis);
659     $self->
660     strict_error_checking
661     ($__orig_strict);
662     }
663     } # XDA
664    
665    
666    
667     }
668    
669    
670     ;}
671    
672     ;
673    
674    
675     }
676    
677     ;
678    
679    
680     }
681     $r}
682     sub create_attribute ($$) {
683     my ($self, $name) = @_;
684     my $r;
685    
686     {
687    
688     my
689     $strict = $self->
690     strict_error_checking
691     ;
692     if ($strict) {
693     my $version = $self->
694     xml_version
695     ;
696    
697    
698     {
699    
700     if
701     (defined $name) {
702    
703    
704     {
705    
706     if
707     (((not defined $version or $version eq '1.0') and
708     not
709     ($name =~ /\A\p{InXML_NameStartChar10}\p{InXMLNameChar10}*\z/)
710     ) or
711     (defined $version and $version eq '1.1' and
712     not
713     ($name =~ /\A\p{InXMLNameStartChar11}\p{InXMLNameChar11}*\z/)
714     )) {
715    
716     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';
717    
718     ;
719     }
720    
721    
722    
723     }
724    
725     ;
726    
727    
728     ;
729     }
730    
731    
732     }
733    
734     ;
735     }
736    
737    
738     {
739    
740     local $Error::Depth = $Error::Depth + 1;
741    
742     {
743    
744    
745    
746     $self->
747     strict_error_checking
748     (
749     0
750     );
751     $r = $self->
752     create_attribute_ns
753     (
754     undef
755     , [
756     undef
757     , $name]);
758     $self->
759     strict_error_checking
760     ($strict);
761    
762    
763    
764     }
765    
766    
767     ;}
768    
769     ;
770    
771    
772     }
773     $r}
774     sub create_attribute_ns ($$$) {
775     my ($self, $namespaceURI, $qualifiedName) = @_;
776    
777     {
778    
779     if
780     (CORE::defined $namespaceURI and CORE::length $namespaceURI == 0) {
781     require Message::DOM::DOMMain;
782    
783 wakaba 1.12 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:1165118814:1861:wAUT122229+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest';
784 wakaba 1.9
785     ;
786    
787    
788    
789     {
790    
791    
792     $namespaceURI = undef;
793    
794    
795    
796     }
797    
798     ;
799     }
800    
801    
802     }
803     my $r;
804    
805     {
806    
807     my
808     ($prefix, $lname) = ref $qualifiedName eq 'ARRAY'
809     ? @$qualifiedName
810     : split /:/, $qualifiedName, 2;
811     ($prefix, $lname) = (
812     undef
813     , $prefix) unless defined $lname;
814    
815     ## TODO: autoload
816     if ((defined $namespaceURI and $namespaceURI eq
817     'http://www.w3.org/XML/1998/namespace'
818     ) or
819     ($lname =~ /^xml:/)) {
820     require Message::DOM::XML;
821     }
822    
823     if ($self->
824     strict_error_checking
825     ) {
826     my $version = $self->
827     xml_version
828     ;
829     $qualifiedName = defined $prefix ? $prefix.':'.$lname
830     : $lname;
831    
832    
833     {
834    
835     if
836     (defined $version and $version eq '1.1') {
837     unless (
838     ($qualifiedName =~ /\A\p{InXMLNameStartChar11}\p{InXMLNameChar11}*\z/)
839     ) {
840    
841     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';
842    
843     ;
844     }
845     unless (
846     ($qualifiedName =~ /\A\p{InXMLNCNameStartChar11}\p{InXMLNCNameChar11}*(?::\p{InXMLNCNameStartChar11}\p{InXMLNCNameChar11}*)?\z/)
847     ) {
848    
849     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';
850    
851     ;
852     }
853     } else {
854     unless (
855     ($qualifiedName =~ /\A\p{InXML_NameStartChar10}\p{InXMLNameChar10}*\z/)
856     ) {
857    
858     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';
859    
860     ;
861     }
862     unless (
863     ($qualifiedName =~ /\A\p{InXML_NCNameStartChar10}\p{InXMLNCNameChar10}*(?::\p{InXML_NCNameStartChar10}\p{InXMLNCNameChar10}*)?\z/)
864     ) {
865    
866     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';
867    
868     ;
869     }
870     }
871    
872    
873     }
874    
875     ;
876    
877    
878     {
879    
880     if
881     (defined $prefix) {
882     if (not defined $namespaceURI) {
883    
884     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';
885    
886     ;
887     } elsif ($prefix eq 'xml' and $namespaceURI ne
888     'http://www.w3.org/XML/1998/namespace'
889     ) {
890    
891     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';
892    
893     ;
894     } elsif ($prefix eq 'xmlns' and $namespaceURI ne
895     'http://www.w3.org/2000/xmlns/'
896     ) {
897    
898     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';
899    
900     ;
901     } elsif ($namespaceURI eq
902     'http://www.w3.org/XML/1998/namespace' and
903     $prefix ne 'xml') {
904    
905     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';
906    
907     ;
908     } elsif ($namespaceURI eq
909     'http://www.w3.org/2000/xmlns/' and
910     $prefix ne 'xmlns') {
911    
912     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';
913    
914     ;
915     }
916     } else { ## No prefix
917     if (not defined $namespaceURI) {
918     #
919     } elsif ($namespaceURI eq
920     'http://www.w3.org/2000/xmlns/' and
921     $lname ne 'xmlns') {
922    
923     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';
924    
925     ;
926     }
927     }
928    
929    
930     }
931    
932     ;
933     }
934    
935     my $bag =
936     $self->{'b'}
937     ;
938     my $stem;
939    
940    
941     {
942    
943    
944     $stem = 'Message::DOM::Element::ManakaiDOMAttr'->___create_node_stem ($bag, {
945    
946     'rc'
947     => 0,
948    
949     'id'
950     => \
951     (
952     'tag:suika.fam.cx,2005-09:' . time . ':' . $$ . ':' .
953     (++$Message::Util::ManakaiNode::UniqueIDN)
954     )
955     ,
956     }, {
957     'od' => $self,
958     'ns' => \$namespaceURI,
959     'pfx' => \$prefix,
960     'ln' => \$lname,
961     'specified' => 1,
962     });
963    
964    
965     {
966    
967     if
968     (defined 'Message::DOM::Element::ManakaiDOMAttr') {
969     if (ref 'Message::DOM::Element::ManakaiDOMAttr' eq 'SCALAR') {
970     $stem->{'cls'} = 'Message::DOM::Element::ManakaiDOMAttr';
971     } elsif (defined $Message::Util::ManakaiStringRef::Value{'Message::DOM::Element::ManakaiDOMAttr'}) {
972     $stem->{'cls'} = $Message::Util::ManakaiStringRef::Value{'Message::DOM::Element::ManakaiDOMAttr'};
973     } else {
974     require Scalar::Util;
975     $stem->{'cls'} = $Message::Util::ManakaiStringRef::Value{'Message::DOM::Element::ManakaiDOMAttr'} = \('Message::DOM::Element::ManakaiDOMAttr');
976     Scalar::Util::weaken ($Message::Util::ManakaiStringRef::Value{'Message::DOM::Element::ManakaiDOMAttr'});
977     }
978     } else {
979     CORE::delete $stem->{'cls'};
980     }
981    
982    
983     }
984    
985     ;
986     $bag->{${$stem->{
987     'id'
988     }}} = $stem;
989    
990    
991     }
992    
993     ;
994    
995    
996     {
997    
998    
999     $r = ${$stem->{
1000     'cls'
1001     }}->___create_node_ref ({
1002    
1003     'id'
1004     => $stem->{
1005     'id'
1006     },
1007    
1008     'b'
1009     => $bag,
1010     }, {
1011     });
1012     $stem->{
1013     'rc'
1014     }++;
1015    
1016    
1017     }
1018    
1019     ;
1020    
1021     ## Attribute type information
1022     if ((defined $namespaceURI and $namespaceURI eq
1023     'http://www.w3.org/XML/1998/namespace' and
1024    
1025     $lname eq 'id') or
1026     (not defined $namespaceURI and $lname eq 'xml:id')) {
1027    
1028    
1029     {
1030    
1031     local $Error::Depth = $Error::Depth + 1;
1032    
1033     {
1034    
1035    
1036     if
1037     ($self->
1038     dom_config
1039    
1040     ->
1041     get_parameter
1042    
1043     (
1044     'http://suika.fam.cx/www/2006/dom-config/xml-id'
1045     )) {
1046     $r->
1047     manakai_attribute_type
1048     (
1049     2
1050     );
1051     }
1052    
1053    
1054    
1055     }
1056    
1057    
1058     ;}
1059    
1060     ;
1061     }
1062    
1063    
1064     }
1065     $r}
1066     $Message::DOM::DOMFeature::ClassInfo->{q<Message::DOM::Element::ManakaiDOMDocumentElement>}->{has_feature} = {};
1067     $Message::DOM::ClassPoint{q<Message::DOM::Element::ManakaiDOMDocumentElement>} = 0;
1068 wakaba 1.1 package Message::DOM::IFLatest::Element;
1069 wakaba 1.12 our $VERSION = 20061203.0432;
1070 wakaba 1.1 package Message::DOM::Element::ManakaiDOMElement;
1071 wakaba 1.12 our $VERSION = 20061203.0432;
1072 wakaba 1.1 push our @ISA, 'Message::DOM::TreeCore::ManakaiDOMNode',
1073     'Message::DOM::IF::Element',
1074     'Message::DOM::IF::Node',
1075     'Message::DOM::IFLatest::Element',
1076     'Message::DOM::IFLatest::Node',
1077     'Message::DOM::IFLevel1::Element',
1078     'Message::DOM::IFLevel1::Node',
1079     'Message::DOM::IFLevel2::Element',
1080     'Message::DOM::IFLevel2::Node',
1081     'Message::DOM::IFLevel3::Element',
1082     'Message::DOM::IFLevel3::Node';
1083     use Char::Class::XML 'InXMLNCNameChar10',
1084     'InXMLNCNameChar11',
1085     'InXMLNCNameStartChar11',
1086     'InXMLNameChar10',
1087     'InXMLNameChar11',
1088     'InXMLNameStartChar11',
1089     'InXML_NCNameStartChar10',
1090     'InXML_NameStartChar10';
1091     sub ___create_node_stem ($$$$) {
1092     my ($self, $bag, $obj, $opt) = @_;
1093     my $r = {};
1094    
1095     {
1096    
1097    
1098     $obj->{
1099     'child'
1100     } = [];
1101     $obj->{
1102     'attr'
1103     } = {};
1104    
1105    
1106     {
1107    
1108     if
1109     (defined ${$opt->{'ns'}}) {
1110     if (ref ${$opt->{'ns'}} eq 'SCALAR') {
1111     $obj->{'ns'} = ${$opt->{'ns'}};
1112     } elsif (defined $Message::Util::ManakaiStringRef::Value{${$opt->{'ns'}}}) {
1113     $obj->{'ns'} = $Message::Util::ManakaiStringRef::Value{${$opt->{'ns'}}};
1114     } else {
1115     require Scalar::Util;
1116     $obj->{'ns'} = $Message::Util::ManakaiStringRef::Value{${$opt->{'ns'}}} = \(${$opt->{'ns'}});
1117     Scalar::Util::weaken ($Message::Util::ManakaiStringRef::Value{${$opt->{'ns'}}});
1118     }
1119     } else {
1120     CORE::delete $obj->{'ns'};
1121     }
1122    
1123    
1124 wakaba 1.3 }
1125 wakaba 1.1
1126     ;
1127    
1128    
1129     {
1130    
1131     if
1132     (defined ${$opt->{'pfx'}}) {
1133     if (ref ${$opt->{'pfx'}} eq 'SCALAR') {
1134     $obj->{'pfx'} = ${$opt->{'pfx'}};
1135     } elsif (defined $Message::Util::ManakaiStringRef::Value{${$opt->{'pfx'}}}) {
1136     $obj->{'pfx'} = $Message::Util::ManakaiStringRef::Value{${$opt->{'pfx'}}};
1137     } else {
1138     require Scalar::Util;
1139     $obj->{'pfx'} = $Message::Util::ManakaiStringRef::Value{${$opt->{'pfx'}}} = \(${$opt->{'pfx'}});
1140     Scalar::Util::weaken ($Message::Util::ManakaiStringRef::Value{${$opt->{'pfx'}}});
1141     }
1142     } else {
1143     CORE::delete $obj->{'pfx'};
1144     }
1145    
1146    
1147 wakaba 1.3 }
1148 wakaba 1.1
1149     ;
1150    
1151    
1152     {
1153    
1154     if
1155     (defined ${$opt->{'ln'}}) {
1156     if (ref ${$opt->{'ln'}} eq 'SCALAR') {
1157     $obj->{'ln'} = ${$opt->{'ln'}};
1158     } elsif (defined $Message::Util::ManakaiStringRef::Value{${$opt->{'ln'}}}) {
1159     $obj->{'ln'} = $Message::Util::ManakaiStringRef::Value{${$opt->{'ln'}}};
1160     } else {
1161     require Scalar::Util;
1162     $obj->{'ln'} = $Message::Util::ManakaiStringRef::Value{${$opt->{'ln'}}} = \(${$opt->{'ln'}});
1163     Scalar::Util::weaken ($Message::Util::ManakaiStringRef::Value{${$opt->{'ln'}}});
1164     }
1165     } else {
1166     CORE::delete $obj->{'ln'};
1167     }
1168    
1169    
1170 wakaba 1.3 }
1171 wakaba 1.1
1172     ;
1173    
1174    
1175     {
1176    
1177    
1178     $obj->{'od'} = $opt->{'od'}->{
1179     'id'
1180     };
1181     $bag->{${$opt->{'od'}->{
1182     'id'
1183     }}}
1184     ->{'do'}->{${$obj->{
1185     'id'
1186     }}}
1187     = $obj->{
1188     'id'
1189     };
1190    
1191    
1192 wakaba 1.3 }
1193 wakaba 1.1
1194     ;
1195     $r = $obj;
1196    
1197    
1198 wakaba 1.3 }
1199 wakaba 1.1 $r}
1200     sub ___create_node_ref ($$$) {
1201     my ($self, $obj, $opt) = @_;
1202     my $r;
1203    
1204     {
1205    
1206     my
1207     $class;
1208     CLS: {
1209 wakaba 1.9 ## From the cache
1210 wakaba 1.1
1211    
1212     {
1213    
1214    
1215     $class = $obj->{
1216     'b'
1217     }->{${$obj->{
1218     'id'
1219     }}}
1220     ->{'dnrcls'};
1221    
1222    
1223 wakaba 1.3 }
1224 wakaba 1.1
1225     ;
1226     if (defined $class) {
1227 wakaba 1.9 last CLS;
1228     } else {
1229     $class = \$self;
1230 wakaba 1.1 }
1231    
1232     my $nsuri;
1233    
1234    
1235     {
1236    
1237    
1238     $nsuri = $obj->{
1239     'b'
1240     }->{${$obj->{
1241     'id'
1242     }}}
1243     ->{'ns'};
1244    
1245    
1246 wakaba 1.3 }
1247 wakaba 1.1
1248     ;
1249     $nsuri = \'' unless defined $nsuri;
1250     my $ln;
1251    
1252    
1253     {
1254    
1255    
1256     $ln = $obj->{
1257     'b'
1258     }->{${$obj->{
1259     'id'
1260     }}}
1261     ->{'ln'};
1262    
1263    
1264 wakaba 1.3 }
1265 wakaba 1.1
1266     ;
1267    
1268 wakaba 1.9 ## Use cases:
1269     ## - |html5:a| element type
1270     ## - |html5:*| element types
1271     A: for my $nm (
1272     [$nsuri, $ln],
1273     [$nsuri, \'*'],
1274     ) {
1275     unless ($Message::DOM::Element::ElementClass
1276     ->{${$nm->[0]}}->{${$nm->[1]}}) {
1277     if ($Message::Util::AutoLoad::Registry::ElementType
1278 wakaba 1.7 ->{${$nm->[0]}}->{${$nm->[1]}}) {
1279 wakaba 1.9 eval qq{require
1280     $Message::Util::AutoLoad::Registry::ElementType->{
1281     ${$nm->[0]}}->{${$nm->[1]}}->{module}};
1282     die $@ if $@;
1283 wakaba 1.7 }
1284 wakaba 1.9 }
1285 wakaba 1.7
1286 wakaba 1.9 if ($Message::DOM::Element::ElementClass
1287     ->{${$nm->[0]}}->{${$nm->[1]}}) {
1288     $class = \($Message::DOM::Element::ElementClass
1289 wakaba 1.7 ->{${$nm->[0]}}->{${$nm->[1]}});
1290 wakaba 1.9 last A;
1291 wakaba 1.1 }
1292     } # A
1293    
1294    
1295    
1296     {
1297    
1298    
1299     $obj->{
1300     'b'
1301     }->{${$obj->{
1302     'id'
1303     }}}
1304     ->{'dnrcls'} = $class;
1305    
1306    
1307 wakaba 1.3 }
1308 wakaba 1.1
1309     ;
1310     } # CLS
1311     $r = bless $obj, $$class;
1312    
1313    
1314 wakaba 1.3 }
1315 wakaba 1.1 $r}
1316     sub node_type ($;$) {
1317     if (@_ == 1) {my ($self) = @_;
1318     my $r;
1319 wakaba 1.6 $r = 1;
1320 wakaba 1.1 $r;
1321     } else {my ($self) = @_;
1322     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';
1323     }
1324     }
1325     sub prefix ($;$) {
1326     if (@_ == 1) {my ($self) = @_;
1327     my $r = '';
1328    
1329     {
1330    
1331     my
1332     $v;
1333    
1334    
1335     {
1336    
1337    
1338     $v = $self->{
1339     'b'
1340     }->{${$self->{
1341     'id'
1342     }}}
1343     ->{'pfx'};
1344    
1345    
1346 wakaba 1.3 }
1347 wakaba 1.1
1348     ;
1349     $r = defined $v ? $$v :
1350     undef
1351     ;
1352    
1353    
1354 wakaba 1.3 }
1355 wakaba 1.1 $r;
1356     } else {my ($self, $given) = @_;
1357    
1358     {
1359    
1360     my
1361     $od = $self->
1362     owner_document
1363     ;
1364     if ($od->
1365     strict_error_checking
1366     ) {
1367    
1368    
1369     {
1370    
1371     if
1372     ($self->
1373     manakai_read_only
1374     ) {
1375    
1376     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';
1377    
1378     ;
1379     }
1380    
1381    
1382 wakaba 1.3 }
1383 wakaba 1.1
1384     ;
1385     my $nsuri;
1386    
1387    
1388     {
1389    
1390    
1391     $nsuri = $self->{
1392     'b'
1393     }->{${$self->{
1394     'id'
1395     }}}
1396     ->{'ns'};
1397    
1398    
1399 wakaba 1.3 }
1400 wakaba 1.1
1401     ;
1402     if (not defined $nsuri) {
1403    
1404     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';
1405    
1406     ;
1407     } elsif ($$nsuri ne
1408     'http://www.w3.org/XML/1998/namespace' and
1409    
1410     defined $given and $given eq 'xml') {
1411    
1412     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';
1413    
1414     ;
1415     }
1416     my $version = $od->
1417     xml_version
1418     ;
1419    
1420    
1421     {
1422    
1423     if
1424     (defined $given and $given eq '') {
1425 wakaba 1.9 require Message::DOM::DOMMain;
1426 wakaba 1.1
1427     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';
1428    
1429     ;
1430     undef $given;
1431     }
1432     if (defined $given) {
1433     if (($version eq '1.0' and
1434     not
1435     ($given =~ /\A\p{InXML_NameStartChar10}\p{InXMLNameChar10}*\z/)
1436     ) or
1437     ($version eq '1.1' and
1438     not
1439     ($given =~ /\A\p{InXMLNameStartChar11}\p{InXMLNameChar11}*\z/)
1440     )) {
1441    
1442     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';
1443    
1444     ;
1445     } elsif (index ($given, ':') > -1) {
1446    
1447     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';
1448    
1449     ;
1450     }
1451     } # has prefix
1452    
1453    
1454 wakaba 1.3 }
1455 wakaba 1.1
1456     ;
1457     } # strict
1458     my $v = defined $given ? \$given :
1459     undef
1460     ;
1461    
1462    
1463     {
1464    
1465    
1466     $self->{
1467     'b'
1468     }->{${$self->{
1469     'id'
1470     }}}
1471     ->{'pfx'} = $v;
1472    
1473    
1474 wakaba 1.3 }
1475 wakaba 1.1
1476     ;
1477    
1478    
1479 wakaba 1.3 }
1480 wakaba 1.1 }
1481     }
1482     sub append_child ($$) {
1483     my ($self, $newChild) = @_;
1484     my $r;
1485    
1486     {
1487    
1488     my
1489     $self_od = $self->
1490     owner_document
1491     ;
1492     if ($self_od->
1493     strict_error_checking
1494     ) {
1495     my $anode = $self;
1496     while (defined $anode) {
1497     if ($anode eq $newChild) {
1498    
1499     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;
1500    
1501     ;
1502     }
1503     $anode = $anode->
1504     parent_node
1505     ;
1506     }
1507     }
1508     my $child_od = $newChild->
1509     owner_document
1510     ;
1511     my $child_nt = $newChild->
1512     node_type
1513     ;
1514    
1515    
1516     {
1517    
1518    
1519     {
1520    
1521     local $Error::Depth = $Error::Depth + 1;
1522    
1523     {
1524    
1525    
1526     my
1527     $strict = $self_od->
1528     strict_error_checking
1529     ;
1530    
1531     ## -- Node Type check
1532     my @new_child;
1533     if ({
1534 wakaba 1.6 3 => 1,
1535     5 => 1,
1536     1 => 1,
1537     4 => 1,
1538     7 => 1,
1539     8 => 1,
1540 wakaba 1.1 }->{$child_nt}) {
1541     push @new_child, $newChild;
1542     } elsif ($child_nt ==
1543 wakaba 1.6 11
1544 wakaba 1.1 ) {
1545     for my $cn (@{$newChild->
1546     child_nodes
1547     }) {
1548     unless ({
1549 wakaba 1.6 3 => 1,
1550     5 => 1,
1551     1 => 1,
1552     4 => 1,
1553     7 => 1,
1554     8 => 1,
1555 wakaba 1.1 }->{$cn->
1556     node_type
1557     }) {
1558    
1559    
1560     {
1561    
1562     local $Error::Depth = $Error::Depth - 1;
1563    
1564     {
1565    
1566     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;
1567    
1568    
1569 wakaba 1.3 }
1570 wakaba 1.1
1571    
1572     ;}
1573    
1574     ;
1575     }
1576     push @new_child, $cn;
1577     }
1578     } else {
1579    
1580    
1581     {
1582    
1583     local $Error::Depth = $Error::Depth - 1;
1584    
1585     {
1586    
1587     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;
1588    
1589    
1590 wakaba 1.3 }
1591 wakaba 1.1
1592    
1593     ;}
1594    
1595     ;
1596     }
1597    
1598     my $nc_parent = @new_child ? $new_child[0]->
1599     parent_node
1600     :
1601    
1602     undef
1603     ;
1604     if ($strict) {
1605     ## -- Wrong-document check
1606     unless ($self_od eq $child_od) {
1607    
1608    
1609     {
1610    
1611     local $Error::Depth = $Error::Depth - 1;
1612    
1613     {
1614    
1615     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;
1616    
1617    
1618 wakaba 1.3 }
1619 wakaba 1.1
1620    
1621     ;}
1622    
1623     ;
1624     }
1625    
1626     ## -- Read-onlyness check
1627     if ($self->
1628     manakai_read_only
1629     ) {
1630    
1631    
1632     {
1633    
1634     local $Error::Depth = $Error::Depth - 1;
1635    
1636     {
1637    
1638     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';
1639    
1640    
1641 wakaba 1.3 }
1642 wakaba 1.1
1643    
1644     ;}
1645    
1646     ;
1647     }
1648     if (@new_child) {
1649     if ($nc_parent and
1650     $nc_parent->
1651     manakai_read_only
1652     ) {
1653    
1654    
1655     {
1656    
1657     local $Error::Depth = $Error::Depth - 1;
1658    
1659     {
1660    
1661     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';
1662    
1663    
1664 wakaba 1.3 }
1665 wakaba 1.1
1666    
1667     ;}
1668    
1669     ;
1670     }
1671     }
1672     }
1673    
1674     ## -- Insert at...
1675     my $index = -1; # last
1676    
1677    
1678     ; # FOR !tc:ForAppendChild
1679    
1680     ## -- Removes from parent
1681     if ($nc_parent) {
1682     if ($child_nt ==
1683 wakaba 1.6 11
1684 wakaba 1.1 ) {
1685    
1686    
1687     {
1688    
1689    
1690     $newChild->{
1691     'b'
1692     }->{${$newChild->{
1693     'id'
1694     }}}
1695     ->{'child'} = [];
1696    
1697    
1698 wakaba 1.3 }
1699 wakaba 1.1
1700     ;
1701     } else {
1702     my $v;
1703    
1704    
1705     {
1706    
1707    
1708     $v = $nc_parent->{
1709     'b'
1710     }->{${$nc_parent->{
1711     'id'
1712     }}}
1713     ->{'child'};
1714    
1715    
1716 wakaba 1.3 }
1717 wakaba 1.1
1718     ;
1719     RP: for my $i (0..$#$v) {
1720     my $nodeid = $v->[$i];
1721     if (
1722     (${$new_child[0]->{'id'}} eq ${$nodeid})
1723     ) {
1724     splice @$v, $i, 1, ();
1725     last RP;
1726     }
1727     } # RP
1728     }
1729     }
1730    
1731     ## -- Rewrite the |parentNode| properties
1732     for my $nc (@new_child) {
1733    
1734    
1735     {
1736    
1737    
1738     $nc->{
1739     'b'
1740     }->{${$nc->{
1741     'id'
1742     }}}
1743     ->{'parent'} = $self->{
1744     'id'
1745     };
1746    
1747    
1748 wakaba 1.3 }
1749 wakaba 1.1
1750     ;
1751     }
1752    
1753     my $children;
1754    
1755    
1756     {
1757    
1758    
1759     $children = $self->{
1760     'b'
1761     }->{${$self->{
1762     'id'
1763     }}}
1764     ->{'child'};
1765    
1766    
1767 wakaba 1.3 }
1768 wakaba 1.1
1769     ;
1770    
1771    
1772    
1773     {
1774    
1775    
1776     ## -- Adds to children list
1777     push @$children, map {
1778    
1779     $_->{'id'}
1780    
1781     } @new_child;
1782     $r = $newChild;
1783    
1784    
1785    
1786 wakaba 1.3 }
1787 wakaba 1.1
1788     ;
1789    
1790    
1791    
1792     ;
1793    
1794    
1795    
1796     ;
1797    
1798    
1799    
1800 wakaba 1.3 }
1801 wakaba 1.1
1802    
1803     ;}
1804    
1805     ;
1806    
1807    
1808 wakaba 1.3 }
1809 wakaba 1.1
1810     ;
1811    
1812    
1813 wakaba 1.3 }
1814 wakaba 1.1 $r}
1815     sub insert_before ($$;$) {
1816     my ($self, $newChild, $refChild) = @_;
1817     my $r;
1818    
1819     {
1820    
1821     my
1822     $self_od = $self->
1823     owner_document
1824     ;
1825     if ($self_od->
1826     strict_error_checking
1827     ) {
1828     my $anode = $self;
1829     while (defined $anode) {
1830     if ($anode eq $newChild) {
1831    
1832     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;
1833    
1834     ;
1835     }
1836     $anode = $anode->
1837     parent_node
1838     ;
1839     }
1840     }
1841     my $child_od = $newChild->
1842     owner_document
1843     ;
1844     my $child_nt = $newChild->
1845     node_type
1846     ;
1847    
1848    
1849     {
1850    
1851    
1852     {
1853    
1854     local $Error::Depth = $Error::Depth + 1;
1855    
1856     {
1857    
1858    
1859     my
1860     $strict = $self_od->
1861     strict_error_checking
1862     ;
1863    
1864     ## -- Node Type check
1865     my @new_child;
1866     if ({
1867 wakaba 1.6 3 => 1,
1868     5 => 1,
1869     1 => 1,
1870     4 => 1,
1871     7 => 1,
1872     8 => 1,
1873 wakaba 1.1 }->{$child_nt}) {
1874     push @new_child, $newChild;
1875     } elsif ($child_nt ==
1876 wakaba 1.6 11
1877 wakaba 1.1 ) {
1878     for my $cn (@{$newChild->
1879     child_nodes
1880     }) {
1881     unless ({
1882 wakaba 1.6 3 => 1,
1883     5 => 1,
1884     1 => 1,
1885     4 => 1,
1886     7 => 1,
1887     8 => 1,
1888 wakaba 1.1 }->{$cn->
1889     node_type
1890     }) {
1891    
1892    
1893     {
1894    
1895     local $Error::Depth = $Error::Depth - 1;
1896    
1897     {
1898    
1899     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;
1900    
1901    
1902 wakaba 1.3 }
1903 wakaba 1.1
1904    
1905     ;}
1906    
1907     ;
1908     }
1909     push @new_child, $cn;
1910     }
1911     } else {
1912    
1913    
1914     {
1915    
1916     local $Error::Depth = $Error::Depth - 1;
1917    
1918     {
1919    
1920     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;
1921    
1922    
1923 wakaba 1.3 }
1924 wakaba 1.1
1925    
1926     ;}
1927    
1928     ;
1929     }
1930    
1931     my $nc_parent = @new_child ? $new_child[0]->
1932     parent_node
1933     :
1934    
1935     undef
1936     ;
1937     if ($strict) {
1938     ## -- Wrong-document check
1939     unless ($self_od eq $child_od) {
1940    
1941    
1942     {
1943    
1944     local $Error::Depth = $Error::Depth - 1;
1945    
1946     {
1947    
1948     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;
1949    
1950    
1951 wakaba 1.3 }
1952 wakaba 1.1
1953    
1954     ;}
1955    
1956     ;
1957     }
1958    
1959     ## -- Read-onlyness check
1960     if ($self->
1961     manakai_read_only
1962     ) {
1963    
1964    
1965     {
1966    
1967     local $Error::Depth = $Error::Depth - 1;
1968    
1969     {
1970    
1971     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';
1972    
1973    
1974 wakaba 1.3 }
1975 wakaba 1.1
1976    
1977     ;}
1978    
1979     ;
1980     }
1981     if (@new_child) {
1982     if ($nc_parent and
1983     $nc_parent->
1984     manakai_read_only
1985     ) {
1986    
1987    
1988     {
1989    
1990     local $Error::Depth = $Error::Depth - 1;
1991    
1992     {
1993    
1994     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';
1995    
1996    
1997 wakaba 1.3 }
1998 wakaba 1.1
1999    
2000     ;}
2001    
2002     ;
2003     }
2004     }
2005     }
2006    
2007     ## -- Insert at...
2008     my $index = -1; # last
2009    
2010    
2011     {
2012    
2013    
2014     # tc:ForAppendChild & tc:ForReplaceChild
2015     if (defined $refChild) {
2016     if ($refChild eq $newChild) {
2017    
2018    
2019     {
2020    
2021    
2022     {
2023    
2024     local $Error::Depth = $Error::Depth - 1;
2025    
2026     {
2027    
2028     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';
2029    
2030    
2031 wakaba 1.3 }
2032 wakaba 1.1
2033    
2034     ;}
2035    
2036     ;
2037    
2038    
2039    
2040 wakaba 1.3 }
2041 wakaba 1.1
2042     ;
2043    
2044    
2045     ;
2046     }
2047    
2048     my $cns = $self->
2049     child_nodes
2050     ;
2051     my $cnsl = @$cns;
2052     C: {
2053     $index = 0;
2054     for my $i (0..($cnsl-1)) {
2055     my $cn = $cns->[$i];
2056     if ($cn eq $refChild) {
2057     $index += $i;
2058     last C;
2059     } elsif ($cn eq $newChild) {
2060     $index = -1; # offset
2061     }
2062     }
2063    
2064    
2065     {
2066    
2067    
2068     {
2069    
2070     local $Error::Depth = $Error::Depth - 1;
2071    
2072     {
2073    
2074     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;
2075    
2076    
2077 wakaba 1.3 }
2078 wakaba 1.1
2079    
2080     ;}
2081    
2082     ;
2083    
2084    
2085    
2086 wakaba 1.3 }
2087 wakaba 1.1
2088     ;
2089    
2090    
2091     ;
2092     } # C
2093     } else { # |oldChild| is not defined
2094    
2095    
2096     ;
2097     }
2098    
2099    
2100    
2101 wakaba 1.3 }
2102 wakaba 1.1
2103     ; # FOR !tc:ForAppendChild
2104    
2105     ## -- Removes from parent
2106     if ($nc_parent) {
2107     if ($child_nt ==
2108 wakaba 1.6 11
2109 wakaba 1.1 ) {
2110    
2111    
2112     {
2113    
2114    
2115     $newChild->{
2116     'b'
2117     }->{${$newChild->{
2118     'id'
2119     }}}
2120     ->{'child'} = [];
2121    
2122    
2123 wakaba 1.3 }
2124 wakaba 1.1
2125     ;
2126     } else {
2127     my $v;
2128    
2129    
2130     {
2131    
2132    
2133     $v = $nc_parent->{
2134     'b'
2135     }->{${$nc_parent->{
2136     'id'
2137     }}}
2138     ->{'child'};
2139    
2140    
2141 wakaba 1.3 }
2142 wakaba 1.1
2143     ;
2144     RP: for my $i (0..$#$v) {
2145     my $nodeid = $v->[$i];
2146     if (
2147     (${$new_child[0]->{'id'}} eq ${$nodeid})
2148     ) {
2149     splice @$v, $i, 1, ();
2150     last RP;
2151     }
2152     } # RP
2153     }
2154     }
2155    
2156     ## -- Rewrite the |parentNode| properties
2157     for my $nc (@new_child) {
2158    
2159    
2160     {
2161    
2162    
2163     $nc->{
2164     'b'
2165     }->{${$nc->{
2166     'id'
2167     }}}
2168     ->{'parent'} = $self->{
2169     'id'
2170     };
2171    
2172    
2173 wakaba 1.3 }
2174 wakaba 1.1
2175     ;
2176     }
2177    
2178     my $children;
2179    
2180    
2181     {
2182    
2183    
2184     $children = $self->{
2185     'b'
2186     }->{${$self->{
2187     'id'
2188     }}}
2189     ->{'child'};
2190    
2191    
2192 wakaba 1.3 }
2193 wakaba 1.1
2194     ;
2195    
2196    
2197    
2198     ;
2199    
2200    
2201    
2202     {
2203    
2204    
2205     ## -- Adds to children list
2206     if ($index == -1) {
2207     push @$children, map {
2208    
2209     $_->{'id'}
2210    
2211     } @new_child;
2212     } else {
2213     splice @$children, $index, 0, map {
2214    
2215     $_->{'id'}
2216    
2217     } @new_child;
2218     }
2219     $r = $newChild;
2220    
2221    
2222    
2223 wakaba 1.3 }
2224 wakaba 1.1
2225     ;
2226    
2227    
2228    
2229     ;
2230    
2231    
2232    
2233 wakaba 1.3 }
2234 wakaba 1.1
2235    
2236     ;}
2237    
2238     ;
2239    
2240    
2241 wakaba 1.3 }
2242 wakaba 1.1
2243     ;
2244    
2245    
2246 wakaba 1.3 }
2247 wakaba 1.1 $r}
2248     sub replace_child ($$$) {
2249     my ($self, $newChild, $oldChild) = @_;
2250     my $r;
2251    
2252     {
2253    
2254     my
2255     $self_od = $self->
2256     owner_document
2257     ;
2258     if ($self_od->
2259     strict_error_checking
2260     ) {
2261     my $anode = $self;
2262     while (defined $anode) {
2263     if ($anode eq $newChild) {
2264    
2265     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;
2266    
2267     ;
2268     }
2269     $anode = $anode->
2270     parent_node
2271     ;
2272     }
2273     }
2274     my $child_od = $newChild->
2275     owner_document
2276     ;
2277     my $child_nt = $newChild->
2278     node_type
2279     ;
2280    
2281    
2282     {
2283    
2284    
2285     {
2286    
2287     local $Error::Depth = $Error::Depth + 1;
2288    
2289     {
2290    
2291    
2292     my
2293     $strict = $self_od->
2294     strict_error_checking
2295     ;
2296    
2297     ## -- Node Type check
2298     my @new_child;
2299     if ({
2300 wakaba 1.6 3 => 1,
2301     5 => 1,
2302     1 => 1,
2303     4 => 1,
2304     7 => 1,
2305     8 => 1,
2306 wakaba 1.1 }->{$child_nt}) {
2307     push @new_child, $newChild;
2308     } elsif ($child_nt ==
2309 wakaba 1.6 11
2310 wakaba 1.1 ) {
2311     for my $cn (@{$newChild->
2312     child_nodes
2313     }) {
2314     unless ({
2315 wakaba 1.6 3 => 1,
2316     5 => 1,
2317     1 => 1,
2318     4 => 1,
2319     7 => 1,
2320     8 => 1,
2321 wakaba 1.1 }->{$cn->
2322     node_type
2323     }) {
2324    
2325    
2326     {
2327    
2328     local $Error::Depth = $Error::Depth - 1;
2329    
2330     {
2331    
2332     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;
2333    
2334    
2335 wakaba 1.3 }
2336 wakaba 1.1
2337    
2338     ;}
2339    
2340     ;
2341     }
2342     push @new_child, $cn;
2343     }
2344     } else {
2345    
2346    
2347     {
2348    
2349     local $Error::Depth = $Error::Depth - 1;
2350    
2351     {
2352    
2353     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;
2354    
2355    
2356 wakaba 1.3 }
2357 wakaba 1.1
2358    
2359     ;}
2360    
2361     ;
2362     }
2363    
2364     my $nc_parent = @new_child ? $new_child[0]->
2365     parent_node
2366     :
2367    
2368     undef
2369     ;
2370     if ($strict) {
2371     ## -- Wrong-document check
2372     unless ($self_od eq $child_od) {
2373    
2374    
2375     {
2376    
2377     local $Error::Depth = $Error::Depth - 1;
2378    
2379     {
2380    
2381     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;
2382    
2383    
2384 wakaba 1.3 }
2385 wakaba 1.1
2386    
2387     ;}
2388    
2389     ;
2390     }
2391    
2392     ## -- Read-onlyness check
2393     if ($self->
2394     manakai_read_only
2395     ) {
2396    
2397    
2398     {
2399    
2400     local $Error::Depth = $Error::Depth - 1;
2401    
2402     {
2403    
2404     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';
2405    
2406    
2407 wakaba 1.3 }
2408 wakaba 1.1
2409    
2410     ;}
2411    
2412     ;
2413     }
2414     if (@new_child) {
2415     if ($nc_parent and
2416     $nc_parent->
2417     manakai_read_only
2418     ) {
2419    
2420    
2421     {
2422    
2423     local $Error::Depth = $Error::Depth - 1;
2424    
2425     {
2426    
2427     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';
2428    
2429    
2430 wakaba 1.3 }
2431 wakaba 1.1
2432    
2433     ;}
2434    
2435     ;
2436     }
2437     }
2438     }
2439    
2440     ## -- Insert at...
2441     my $index = -1; # last
2442    
2443    
2444     {
2445    
2446    
2447     # tc:ForAppendChild & tc:ForReplaceChild
2448     if (defined $oldChild) {
2449     if ($oldChild eq $newChild) {
2450    
2451    
2452     ;
2453    
2454    
2455     {
2456    
2457    
2458     {
2459    
2460     local $Error::Depth = $Error::Depth - 1;
2461    
2462     {
2463    
2464     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';
2465    
2466    
2467 wakaba 1.3 }
2468 wakaba 1.1
2469    
2470     ;}
2471    
2472     ;
2473    
2474    
2475    
2476 wakaba 1.3 }
2477 wakaba 1.1
2478     ;
2479     }
2480    
2481     my $cns = $self->
2482     child_nodes
2483     ;
2484     my $cnsl = @$cns;
2485     C: {
2486     $index = 0;
2487     for my $i (0..($cnsl-1)) {
2488     my $cn = $cns->[$i];
2489     if ($cn eq $oldChild) {
2490     $index += $i;
2491     last C;
2492     } elsif ($cn eq $newChild) {
2493     $index = -1; # offset
2494     }
2495     }
2496    
2497    
2498     ;
2499    
2500    
2501     {
2502    
2503    
2504     {
2505    
2506     local $Error::Depth = $Error::Depth - 1;
2507    
2508     {
2509    
2510     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;
2511    
2512    
2513 wakaba 1.3 }
2514 wakaba 1.1
2515    
2516     ;}
2517    
2518     ;
2519    
2520    
2521    
2522 wakaba 1.3 }
2523 wakaba 1.1
2524     ;
2525     } # C
2526     } else { # |oldChild| is not defined
2527    
2528    
2529     {
2530    
2531    
2532     {
2533    
2534     local $Error::Depth = $Error::Depth - 1;
2535    
2536     {
2537    
2538     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;
2539    
2540    
2541 wakaba 1.3 }
2542 wakaba 1.1
2543    
2544     ;}
2545    
2546     ;
2547    
2548    
2549    
2550 wakaba 1.3 }
2551 wakaba 1.1
2552     ;
2553     }
2554    
2555    
2556    
2557 wakaba 1.3 }
2558 wakaba 1.1
2559     ; # FOR !tc:ForAppendChild
2560    
2561     ## -- Removes from parent
2562     if ($nc_parent) {
2563     if ($child_nt ==
2564 wakaba 1.6 11
2565 wakaba 1.1 ) {
2566    
2567    
2568     {
2569    
2570    
2571     $newChild->{
2572     'b'
2573     }->{${$newChild->{
2574     'id'
2575     }}}
2576     ->{'child'} = [];
2577    
2578    
2579 wakaba 1.3 }
2580 wakaba 1.1
2581     ;
2582     } else {
2583     my $v;
2584    
2585    
2586     {
2587    
2588    
2589     $v = $nc_parent->{
2590     'b'
2591     }->{${$nc_parent->{
2592     'id'
2593     }}}
2594     ->{'child'};
2595    
2596    
2597 wakaba 1.3 }
2598 wakaba 1.1
2599     ;
2600     RP: for my $i (0..$#$v) {
2601     my $nodeid = $v->[$i];
2602     if (
2603     (${$new_child[0]->{'id'}} eq ${$nodeid})
2604     ) {
2605     splice @$v, $i, 1, ();
2606     last RP;
2607     }
2608     } # RP
2609     }
2610     }
2611    
2612     ## -- Rewrite the |parentNode| properties
2613     for my $nc (@new_child) {
2614    
2615    
2616     {
2617    
2618    
2619     $nc->{
2620     'b'
2621     }->{${$nc->{
2622     'id'
2623     }}}
2624     ->{'parent'} = $self->{
2625     'id'
2626     };
2627    
2628    
2629 wakaba 1.3 }
2630 wakaba 1.1
2631     ;
2632     }
2633    
2634     my $children;
2635    
2636    
2637     {
2638    
2639    
2640     $children = $self->{
2641     'b'
2642     }->{${$self->{
2643     'id'
2644     }}}
2645     ->{'child'};
2646    
2647    
2648 wakaba 1.3 }
2649 wakaba 1.1
2650     ;
2651    
2652    
2653    
2654     ;
2655    
2656    
2657    
2658     ;
2659    
2660    
2661    
2662     {
2663    
2664    
2665     ## -- Replaces the node
2666     splice @$children, $index, 1, map {
2667    
2668     $_->{'id'}
2669    
2670     } @new_child;
2671    
2672    
2673     {
2674    
2675     CORE::delete
2676     $oldChild->{
2677     'b'
2678     }->{${$oldChild->{
2679     'id'
2680     }}}
2681     ->{'parent'};
2682    
2683    
2684 wakaba 1.3 }
2685 wakaba 1.1
2686     ;
2687     $r = $oldChild;
2688    
2689    
2690    
2691 wakaba 1.3 }
2692 wakaba 1.1
2693     ;
2694    
2695    
2696    
2697 wakaba 1.3 }
2698 wakaba 1.1
2699    
2700     ;}
2701    
2702     ;
2703    
2704    
2705 wakaba 1.3 }
2706 wakaba 1.1
2707     ;
2708    
2709    
2710 wakaba 1.3 }
2711 wakaba 1.1 $r}
2712     sub attributes ($;$) {
2713     if (@_ == 1) {my ($self) = @_;
2714     my $r;
2715    
2716     {
2717    
2718    
2719     {
2720    
2721    
2722     $r = bless \\($self),
2723     'Message::DOM::TreeCore::ManakaiDOMAttrMap'
2724     ;
2725    
2726    
2727     {
2728    
2729    
2730     $self->{
2731     'b'
2732     }->{${$self->{
2733     'id'
2734     }}}
2735     ->{'hpos'} ||= -1;
2736    
2737    
2738 wakaba 1.3 }
2739 wakaba 1.1
2740     ;
2741    
2742    
2743 wakaba 1.3 }
2744 wakaba 1.1
2745     ;
2746    
2747    
2748 wakaba 1.3 }
2749 wakaba 1.1 $r;
2750     } else {my ($self) = @_;
2751     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';
2752     }
2753     }
2754     sub node_name ($;$) {
2755     if (@_ == 1) {my ($self) = @_;
2756     my $r = '';
2757    
2758     {
2759    
2760     my
2761     $prefix;
2762    
2763    
2764     {
2765    
2766    
2767     $prefix = $self->{
2768     'b'
2769     }->{${$self->{
2770     'id'
2771     }}}
2772     ->{'pfx'};
2773    
2774    
2775 wakaba 1.3 }
2776 wakaba 1.1
2777     ;
2778     my $lname;
2779    
2780    
2781     {
2782    
2783    
2784     $lname = $self->{
2785     'b'
2786     }->{${$self->{
2787     'id'
2788     }}}
2789     ->{'ln'};
2790    
2791    
2792 wakaba 1.3 }
2793 wakaba 1.1
2794     ;
2795     $r = defined $prefix ? $$prefix.':'.$$lname : $$lname;
2796    
2797    
2798 wakaba 1.3 }
2799 wakaba 1.1 $r;
2800     } else {my ($self) = @_;
2801     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';
2802     }
2803     }
2804     sub tag_name ($;$) {
2805     if (@_ == 1) {my ($self) = @_;
2806     my $r = '';
2807    
2808     {
2809    
2810     my
2811     $prefix;
2812    
2813    
2814     {
2815    
2816    
2817     $prefix = $self->{
2818     'b'
2819     }->{${$self->{
2820     'id'
2821     }}}
2822     ->{'pfx'};
2823    
2824    
2825 wakaba 1.3 }
2826 wakaba 1.1
2827     ;
2828     my $lname;
2829    
2830    
2831     {
2832    
2833    
2834     $lname = $self->{
2835     'b'
2836     }->{${$self->{
2837     'id'
2838     }}}
2839     ->{'ln'};
2840    
2841    
2842 wakaba 1.3 }
2843 wakaba 1.1
2844     ;
2845     $r = defined $prefix ? $$prefix.':'.$$lname : $$lname;
2846    
2847    
2848 wakaba 1.3 }
2849 wakaba 1.1 $r;
2850     } else {my ($self) = @_;
2851     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';
2852     }
2853     }
2854     sub manakai_append_text ($$) {
2855     my ($self, $string) = @_;
2856     my $r;
2857    
2858     {
2859    
2860    
2861     {
2862    
2863     local $Error::Depth = $Error::Depth + 1;
2864    
2865     {
2866    
2867    
2868     my
2869     $lc = $self->
2870     last_child
2871     ;
2872     if (defined $lc and
2873     $lc->
2874     node_type
2875     ==
2876 wakaba 1.6 3
2877 wakaba 1.1 ) {
2878     $lc->
2879     manakai_append_text
2880    
2881     (ref $string eq 'SCALAR' ? $string : \$string);
2882     } else {
2883     my $text = $self->
2884     owner_document
2885    
2886     ->
2887     create_text_node
2888    
2889     (ref $string eq 'SCALAR' ? $$string : $string);
2890     $self->
2891     append_child
2892     ($text);
2893     }
2894     $r = $self;
2895    
2896    
2897    
2898 wakaba 1.3 }
2899 wakaba 1.1
2900    
2901     ;}
2902    
2903     ;
2904    
2905    
2906 wakaba 1.3 }
2907 wakaba 1.1 $r}
2908     sub get_feature ($$$) {
2909     my ($self, $feature, $version) = @_;
2910    
2911     {
2912    
2913    
2914     $feature = lc $feature;
2915    
2916    
2917 wakaba 1.3 }
2918 wakaba 1.1
2919     {
2920    
2921    
2922     $version = '' unless defined $version;
2923    
2924    
2925 wakaba 1.3 }
2926 wakaba 1.1 my $r;
2927    
2928     {
2929    
2930    
2931     $feature =~ s/^\+//;
2932    
2933    
2934     {
2935    
2936     if
2937 wakaba 1.9 ($Message::Util::AutoLoad::Registry::Feature->{$feature}->{$version}) {
2938 wakaba 1.1 $r = $self;
2939     }
2940    
2941    
2942 wakaba 1.3 }
2943 wakaba 1.1
2944     ;
2945     unless (defined $r) {
2946    
2947    
2948     {
2949    
2950     local $Error::Depth = $Error::Depth + 1;
2951    
2952     {
2953    
2954    
2955    
2956     $r = $self->SUPER::get_feature ($feature, $version);
2957    
2958    
2959    
2960 wakaba 1.3 }
2961 wakaba 1.1
2962    
2963     ;}
2964    
2965     ;
2966     }
2967    
2968    
2969 wakaba 1.3 }
2970 wakaba 1.1 $r}
2971     sub base_uri ($;$) {
2972     if (@_ == 1) {my ($self) = @_;
2973     my $r = '';
2974    
2975     {
2976    
2977    
2978     {
2979    
2980    
2981     $r = $self->{
2982     'b'
2983     }->{${$self->{
2984     'id'
2985     }}}
2986     ->{'buri'};
2987    
2988    
2989 wakaba 1.3 }
2990 wakaba 1.1
2991     ;
2992     unless (defined $r) {
2993    
2994    
2995     {
2996    
2997     local $Error::Depth = $Error::Depth + 1;
2998    
2999     {
3000    
3001    
3002     my
3003     $xb = $self->
3004     get_attribute_node_ns
3005    
3006     (
3007     'http://www.w3.org/XML/1998/namespace'
3008     , 'base');
3009     unless (defined $xb) {
3010     $xb = $self->
3011     get_attribute_node_ns
3012    
3013     (
3014     undef
3015     , 'xml:base');
3016     }
3017     if ($xb) {
3018     $r = $xb->
3019     value
3020     ;
3021     if (
3022     ($r !~ m!\A[^:/?#]+:!)
3023     ) {
3024     my $xbbase = $xb->
3025     base_uri
3026     ;
3027     $r = $self->
3028     owner_document
3029    
3030     ->
3031     implementation
3032    
3033     ->
3034     create_uri_reference
3035    
3036     ($r)
3037     ->
3038     get_absolute_reference
3039    
3040     ($xbbase)
3041     ->
3042     uri_reference
3043     if
3044     defined $xbbase;
3045     }
3046     } else {
3047     my $pe = $self->
3048     parent_node
3049     ;
3050     W: {
3051     while (defined $pe) {
3052     my $nt = $pe->
3053     node_type
3054     ;
3055     if ($nt ==
3056 wakaba 1.6 1 or
3057 wakaba 1.1
3058     $nt ==
3059 wakaba 1.6 9 or
3060 wakaba 1.1
3061     $nt ==
3062 wakaba 1.6 11 or
3063 wakaba 1.1
3064     $nt ==
3065 wakaba 1.6 6
3066 wakaba 1.1 ) {
3067     $r = $pe->
3068     base_uri
3069     ;
3070     last W;
3071     } elsif ($nt ==
3072 wakaba 1.6 5
3073 wakaba 1.1 ) {
3074     if ($pe->
3075     manakai_external
3076     ) {
3077     $r = $pe->
3078     manakai_entity_base_uri
3079     ;
3080     last W;
3081     }
3082     }
3083     $pe = $pe->
3084     parent_node
3085     ;
3086     }
3087     if ($pe) {
3088     $r = $pe->
3089     base_uri
3090     ;
3091     } else {
3092     $r = $self->
3093     owner_document
3094     ->
3095     base_uri
3096     ;
3097     }
3098     } # W
3099     }
3100    
3101    
3102    
3103 wakaba 1.3 }
3104 wakaba 1.1
3105    
3106     ;}
3107    
3108     ;
3109     }
3110    
3111    
3112 wakaba 1.3 }
3113 wakaba 1.1 $r;
3114     } else {my ($self) = @_;
3115     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';
3116     }
3117     }
3118     sub get_attribute ($$) {
3119     my ($self, $name) = @_;
3120     my $r = '';
3121    
3122     {
3123    
3124     my
3125     $node;
3126    
3127    
3128     {
3129    
3130     my
3131     $__attr;
3132    
3133    
3134     {
3135    
3136    
3137     $__attr = $self->{
3138     'b'
3139     }->{${$self->{
3140     'id'
3141     }}}
3142     ->{'attr'};
3143    
3144    
3145 wakaba 1.3 }
3146 wakaba 1.1
3147     ;
3148    
3149     ## Note that we no longer support DOM Level 1 nodes.
3150    
3151     ## If an attribute's qualified name is equal to
3152     ## the requested name, then the node is the answer.
3153    
3154     ## Note that if there is a namespace ill-formed attribute,
3155     ## the result is not the expected one. For example,
3156     ## if an |xmlns| attribute in the |http://www.w3.org/2000/xmlns/|
3157     ## namespace has non-NULL |prefix|, a request to get |xmlns|
3158     ## attribute will not return that node.
3159    
3160     ## |sort|ing is required so that every |getAttribute|, |setAttribute|,
3161     ## |hasAttribute|, |removeAttribute|, or any other namespace unaware
3162     ## methods operates on the same node even if there is
3163     ## multiple nodes with the same qualified name.
3164    
3165     NS: for my $__ns (sort {$a cmp $b} keys %$__attr) {
3166     for my $__ln (sort {$a cmp $b} keys %{$__attr->{$__ns}}) {
3167     my $__node;
3168    
3169    
3170     {
3171    
3172    
3173     $__node = ${($self->{'b'})->{${$__attr->{$__ns}->{$__ln}}}->{
3174     'cls'
3175     }}->___create_node_ref ({
3176    
3177     'id'
3178     => $__attr->{$__ns}->{$__ln},
3179    
3180     'b'
3181     => ($self->{'b'}),
3182     }, {
3183     });
3184     ($self->{'b'})->{${$__attr->{$__ns}->{$__ln}}}->{
3185     'rc'
3186     }++;
3187    
3188    
3189 wakaba 1.3 }
3190 wakaba 1.1
3191     ;
3192     if ($__node->
3193     node_name eq
3194     $name) {
3195    
3196    
3197     {
3198    
3199    
3200     $node = $__node;
3201    
3202    
3203    
3204 wakaba 1.3 }
3205 wakaba 1.1
3206     ;
3207    
3208    
3209     ;
3210     last NS;
3211     }
3212     } # ln
3213     } # NS
3214    
3215    
3216 wakaba 1.3 }
3217 wakaba 1.1
3218     ;
3219     if (defined $node) {
3220     $r = $node->
3221     value
3222     ;
3223     } else {
3224     $r =
3225     undef
3226     ;
3227     }
3228    
3229    
3230 wakaba 1.3 }
3231 wakaba 1.1 $r}
3232     sub get_attribute_ns ($$$) {
3233     my ($self, $namespaceURI, $localName) = @_;
3234    
3235     {
3236    
3237     if
3238     (CORE::defined $namespaceURI and CORE::length $namespaceURI == 0) {
3239 wakaba 1.9 require Message::DOM::DOMMain;
3240 wakaba 1.1
3241 wakaba 1.12 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:1165118814:1861:wAUT122229+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest';
3242 wakaba 1.1
3243     ;
3244    
3245    
3246    
3247     {
3248    
3249    
3250     $namespaceURI = undef;
3251    
3252    
3253    
3254 wakaba 1.3 }
3255 wakaba 1.1
3256     ;
3257     }
3258    
3259    
3260 wakaba 1.3 }
3261 wakaba 1.1 my $r = '';
3262    
3263     {
3264    
3265     my
3266     $node;
3267    
3268    
3269     {
3270    
3271     my
3272     $__attrs;
3273    
3274    
3275     {
3276    
3277    
3278     $__attrs = $self->{
3279     'b'
3280     }->{${$self->{
3281     'id'
3282     }}}
3283     ->{'attr'};
3284    
3285    
3286 wakaba 1.3 }
3287 wakaba 1.1
3288     ;
3289     if (defined $__attrs->{defined $namespaceURI ? $namespaceURI : ''}
3290     ->{$localName}) {
3291    
3292    
3293     {
3294    
3295    
3296     $node = ${($self->{'b'})->{${$__attrs->{defined $namespaceURI ? $namespaceURI : ''}
3297     ->{$localName}}}->{
3298     'cls'
3299     }}->___create_node_ref ({
3300    
3301     'id'
3302     => $__attrs->{defined $namespaceURI ? $namespaceURI : ''}
3303     ->{$localName},
3304    
3305     'b'
3306     => ($self->{'b'}),
3307     }, {
3308     });
3309     ($self->{'b'})->{${$__attrs->{defined $namespaceURI ? $namespaceURI : ''}
3310     ->{$localName}}}->{
3311     'rc'
3312     }++;
3313    
3314    
3315 wakaba 1.3 }
3316 wakaba 1.1
3317     ;
3318     }
3319    
3320    
3321 wakaba 1.3 }
3322 wakaba 1.1
3323     ;
3324     if (defined $node) {
3325     $r = $node->
3326     value
3327     ;
3328     } else {
3329     $r =
3330     undef
3331     ;
3332     }
3333    
3334    
3335 wakaba 1.3 }
3336 wakaba 1.1 $r}
3337     sub get_attribute_node ($$) {
3338     my ($self, $name) = @_;
3339     my $r;
3340    
3341     {
3342    
3343    
3344     {
3345    
3346     my
3347     $__attr;
3348    
3349    
3350     {
3351    
3352    
3353     $__attr = $self->{
3354     'b'
3355     }->{${$self->{
3356     'id'
3357     }}}
3358     ->{'attr'};
3359    
3360    
3361 wakaba 1.3 }
3362 wakaba 1.1
3363     ;
3364    
3365     ## Note that we no longer support DOM Level 1 nodes.
3366    
3367     ## If an attribute's qualified name is equal to
3368     ## the requested name, then the node is the answer.
3369    
3370     ## Note that if there is a namespace ill-formed attribute,
3371     ## the result is not the expected one. For example,
3372     ## if an |xmlns| attribute in the |http://www.w3.org/2000/xmlns/|
3373     ## namespace has non-NULL |prefix|, a request to get |xmlns|
3374     ## attribute will not return that node.
3375    
3376     ## |sort|ing is required so that every |getAttribute|, |setAttribute|,
3377     ## |hasAttribute|, |removeAttribute|, or any other namespace unaware
3378     ## methods operates on the same node even if there is
3379     ## multiple nodes with the same qualified name.
3380    
3381     NS: for my $__ns (sort {$a cmp $b} keys %$__attr) {
3382     for my $__ln (sort {$a cmp $b} keys %{$__attr->{$__ns}}) {
3383     my $__node;
3384    
3385    
3386     {
3387    
3388    
3389     $__node = ${($self->{'b'})->{${$__attr->{$__ns}->{$__ln}}}->{
3390     'cls'
3391     }}->___create_node_ref ({
3392    
3393     'id'
3394     => $__attr->{$__ns}->{$__ln},
3395    
3396     'b'
3397     => ($self->{'b'}),
3398     }, {
3399     });
3400     ($self->{'b'})->{${$__attr->{$__ns}->{$__ln}}}->{
3401     'rc'
3402     }++;
3403    
3404    
3405 wakaba 1.3 }
3406 wakaba 1.1
3407     ;
3408     if ($__node->
3409     node_name eq
3410     $name) {
3411    
3412    
3413     {
3414    
3415    
3416     $r = $__node;
3417    
3418    
3419    
3420 wakaba 1.3 }
3421 wakaba 1.1
3422     ;
3423    
3424    
3425     ;
3426     last NS;
3427     }
3428     } # ln
3429     } # NS
3430    
3431    
3432 wakaba 1.3 }
3433 wakaba 1.1
3434     ;
3435    
3436    
3437 wakaba 1.3 }
3438 wakaba 1.1 $r}
3439     sub get_attribute_node_ns ($$$) {
3440     my ($self, $namespaceURI, $localName) = @_;
3441    
3442     {
3443    
3444     if
3445     (CORE::defined $namespaceURI and CORE::length $namespaceURI == 0) {
3446 wakaba 1.9 require Message::DOM::DOMMain;
3447 wakaba 1.1
3448 wakaba 1.12 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:1165118814:1861:wAUT122229+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest';
3449 wakaba 1.1
3450     ;
3451    
3452    
3453    
3454     {
3455    
3456    
3457     $namespaceURI = undef;
3458    
3459    
3460    
3461 wakaba 1.3 }
3462 wakaba 1.1
3463     ;
3464     }
3465    
3466    
3467 wakaba 1.3 }
3468 wakaba 1.1 my $r;
3469    
3470     {
3471    
3472    
3473     {
3474    
3475     my
3476     $__attrs;
3477    
3478    
3479     {
3480    
3481    
3482     $__attrs = $self->{
3483     'b'
3484     }->{${$self->{
3485     'id'
3486     }}}
3487     ->{'attr'};
3488    
3489    
3490 wakaba 1.3 }
3491 wakaba 1.1
3492     ;
3493     if (defined $__attrs->{defined $namespaceURI ? $namespaceURI : ''}
3494     ->{$localName}) {
3495    
3496    
3497     {
3498    
3499    
3500     $r = ${($self->{'b'})->{${$__attrs->{defined $namespaceURI ? $namespaceURI : ''}
3501     ->{$localName}}}->{
3502     'cls'
3503     }}->___create_node_ref ({
3504    
3505     'id'
3506     => $__attrs->{defined $namespaceURI ? $namespaceURI : ''}
3507     ->{$localName},
3508    
3509     'b'
3510     => ($self->{'b'}),
3511     }, {
3512     });
3513     ($self->{'b'})->{${$__attrs->{defined $namespaceURI ? $namespaceURI : ''}
3514     ->{$localName}}}->{
3515     'rc'
3516     }++;
3517    
3518    
3519 wakaba 1.3 }
3520 wakaba 1.1
3521     ;
3522     }
3523    
3524    
3525 wakaba 1.3 }
3526 wakaba 1.1
3527     ;
3528    
3529    
3530 wakaba 1.3 }
3531 wakaba 1.1 $r}
3532     sub has_attribute ($$) {
3533     my ($self, $name) = @_;
3534     my $r = 0;
3535    
3536     {
3537    
3538     my
3539     $node;
3540    
3541    
3542     {
3543    
3544     my
3545     $__attr;
3546    
3547    
3548     {
3549    
3550    
3551     $__attr = $self->{
3552     'b'
3553     }->{${$self->{
3554     'id'
3555     }}}
3556     ->{'attr'};
3557    
3558    
3559 wakaba 1.3 }
3560 wakaba 1.1
3561     ;
3562    
3563     ## Note that we no longer support DOM Level 1 nodes.
3564    
3565     ## If an attribute's qualified name is equal to
3566     ## the requested name, then the node is the answer.
3567    
3568     ## Note that if there is a namespace ill-formed attribute,
3569     ## the result is not the expected one. For example,
3570     ## if an |xmlns| attribute in the |http://www.w3.org/2000/xmlns/|
3571     ## namespace has non-NULL |prefix|, a request to get |xmlns|
3572     ## attribute will not return that node.
3573    
3574     ## |sort|ing is required so that every |getAttribute|, |setAttribute|,
3575     ## |hasAttribute|, |removeAttribute|, or any other namespace unaware
3576     ## methods operates on the same node even if there is
3577     ## multiple nodes with the same qualified name.
3578    
3579     NS: for my $__ns (sort {$a cmp $b} keys %$__attr) {
3580     for my $__ln (sort {$a cmp $b} keys %{$__attr->{$__ns}}) {
3581     my $__node;
3582    
3583    
3584     {
3585    
3586    
3587     $__node = ${($self->{'b'})->{${$__attr->{$__ns}->{$__ln}}}->{
3588     'cls'
3589     }}->___create_node_ref ({
3590    
3591     'id'
3592     => $__attr->{$__ns}->{$__ln},
3593    
3594     'b'
3595     => ($self->{'b'}),
3596     }, {
3597     });
3598     ($self->{'b'})->{${$__attr->{$__ns}->{$__ln}}}->{
3599     'rc'
3600     }++;
3601    
3602    
3603 wakaba 1.3 }
3604 wakaba 1.1
3605     ;
3606     if ($__node->
3607     node_name eq
3608     $name) {
3609    
3610    
3611     {
3612    
3613    
3614     $node = $__node;
3615    
3616    
3617    
3618 wakaba 1.3 }
3619 wakaba 1.1
3620     ;
3621    
3622    
3623     ;
3624     last NS;
3625     }
3626     } # ln
3627     } # NS
3628    
3629    
3630 wakaba 1.3 }
3631 wakaba 1.1
3632     ;
3633     $r = defined $node;
3634    
3635    
3636 wakaba 1.3 }
3637 wakaba 1.1 $r}
3638     sub has_attribute_ns ($$$) {
3639     my ($self, $namespaceURI, $localName) = @_;
3640    
3641     {
3642    
3643     if
3644     (CORE::defined $namespaceURI and CORE::length $namespaceURI == 0) {
3645 wakaba 1.9 require Message::DOM::DOMMain;
3646 wakaba 1.1
3647 wakaba 1.12 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:1165118814:1861:wAUT122229+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest';
3648 wakaba 1.1
3649     ;
3650    
3651    
3652    
3653     {
3654    
3655    
3656     $namespaceURI = undef;
3657    
3658    
3659    
3660 wakaba 1.3 }
3661 wakaba 1.1
3662     ;
3663     }
3664    
3665    
3666 wakaba 1.3 }
3667 wakaba 1.1 my $r = 0;
3668    
3669     {
3670    
3671     my
3672     $node;
3673    
3674    
3675     {
3676    
3677     my
3678     $__attrs;
3679    
3680    
3681     {
3682    
3683    
3684     $__attrs = $self->{
3685     'b'
3686     }->{${$self->{
3687     'id'
3688     }}}
3689     ->{'attr'};
3690    
3691    
3692 wakaba 1.3 }
3693 wakaba 1.1
3694     ;
3695     if (defined $__attrs->{defined $namespaceURI ? $namespaceURI : ''}
3696     ->{$localName}) {
3697    
3698    
3699     {
3700    
3701    
3702     $node = ${($self->{'b'})->{${$__attrs->{defined $namespaceURI ? $namespaceURI : ''}
3703     ->{$localName}}}->{
3704     'cls'
3705     }}->___create_node_ref ({
3706    
3707     'id'
3708     => $__attrs->{defined $namespaceURI ? $namespaceURI : ''}
3709     ->{$localName},
3710    
3711     'b'
3712     => ($self->{'b'}),
3713     }, {
3714     });
3715     ($self->{'b'})->{${$__attrs->{defined $namespaceURI ? $namespaceURI : ''}
3716     ->{$localName}}}->{
3717     'rc'
3718     }++;
3719    
3720    
3721 wakaba 1.3 }
3722 wakaba 1.1
3723     ;
3724     }
3725    
3726    
3727 wakaba 1.3 }
3728 wakaba 1.1
3729     ;
3730     $r = defined $node;
3731    
3732    
3733 wakaba 1.3 }
3734 wakaba 1.1 $r}
3735     sub set_attribute ($$$) {
3736     my ($self, $name, $value) = @_;
3737    
3738     {
3739    
3740     my
3741     $od = $self->
3742     owner_document
3743     ;
3744     if ($od->
3745     strict_error_checking
3746     ) {
3747     if ($self->
3748     manakai_read_only
3749     ) {
3750    
3751     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';
3752    
3753     ;
3754     }
3755     my $version = $od->
3756     xml_version
3757     ;
3758    
3759    
3760     {
3761    
3762     if
3763     (defined $name) {
3764    
3765    
3766     {
3767    
3768     if
3769     (((not defined $version or $version eq '1.0') and
3770     not
3771     ($name =~ /\A\p{InXML_NameStartChar10}\p{InXMLNameChar10}*\z/)
3772     ) or
3773     (defined $version and $version eq '1.1' and
3774     not
3775     ($name =~ /\A\p{InXMLNameStartChar11}\p{InXMLNameChar11}*\z/)
3776     )) {
3777    
3778     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';
3779    
3780     ;
3781     }
3782    
3783    
3784    
3785 wakaba 1.3 }
3786 wakaba 1.1
3787     ;
3788    
3789    
3790     ;
3791     }
3792    
3793    
3794 wakaba 1.3 }
3795 wakaba 1.1
3796     ;
3797     }
3798    
3799     my $__anode;
3800    
3801    
3802     {
3803    
3804     my
3805     $__attr;
3806    
3807    
3808     {
3809    
3810    
3811     $__attr = $self->{
3812     'b'
3813     }->{${$self->{
3814     'id'
3815     }}}
3816     ->{'attr'};
3817    
3818    
3819 wakaba 1.3 }
3820 wakaba 1.1
3821     ;
3822    
3823     ## Note that we no longer support DOM Level 1 nodes.
3824    
3825     ## If an attribute's qualified name is equal to
3826     ## the requested name, then the node is the answer.
3827    
3828     ## Note that if there is a namespace ill-formed attribute,
3829     ## the result is not the expected one. For example,
3830     ## if an |xmlns| attribute in the |http://www.w3.org/2000/xmlns/|
3831     ## namespace has non-NULL |prefix|, a request to get |xmlns|
3832     ## attribute will not return that node.
3833    
3834     ## |sort|ing is required so that every |getAttribute|, |setAttribute|,
3835     ## |hasAttribute|, |removeAttribute|, or any other namespace unaware
3836     ## methods operates on the same node even if there is
3837     ## multiple nodes with the same qualified name.
3838    
3839     NS: for my $__ns (sort {$a cmp $b} keys %$__attr) {
3840     for my $__ln (sort {$a cmp $b} keys %{$__attr->{$__ns}}) {
3841     my $__node;
3842    
3843    
3844     {
3845    
3846    
3847     $__node = ${($self->{'b'})->{${$__attr->{$__ns}->{$__ln}}}->{
3848     'cls'
3849     }}->___create_node_ref ({
3850    
3851     'id'
3852     => $__attr->{$__ns}->{$__ln},
3853    
3854     'b'
3855     => ($self->{'b'}),
3856     }, {
3857     });
3858     ($self->{'b'})->{${$__attr->{$__ns}->{$__ln}}}->{
3859     'rc'
3860     }++;
3861    
3862    
3863 wakaba 1.3 }
3864 wakaba 1.1
3865     ;
3866     if ($__node->
3867     node_name eq
3868     $name) {
3869    
3870    
3871     {
3872    
3873    
3874     $__anode = $__node;
3875    
3876    
3877    
3878 wakaba 1.3 }
3879 wakaba 1.1
3880     ;
3881    
3882    
3883     ;
3884     last NS;
3885     }
3886     } # ln
3887     } # NS
3888    
3889    
3890 wakaba 1.3 }
3891 wakaba 1.1
3892     ;
3893     if (defined $__anode) { ## There is already a node with such a |name|
3894     if ($__anode->
3895     manakai_read_only
3896     ) {
3897    
3898     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;
3899    
3900     ;
3901     }
3902     } else { ## There is no such attribute
3903    
3904    
3905     {
3906    
3907     local $Error::Depth = $Error::Depth + 1;
3908    
3909     {
3910    
3911    
3912    
3913     $__anode = $od->
3914     create_attribute
3915     ($name);
3916     my $__attrs;
3917    
3918    
3919     {
3920    
3921    
3922     $__attrs = $self->{
3923     'b'
3924     }->{${$self->{
3925     'id'
3926     }}}
3927     ->{'attr'};
3928    
3929    
3930 wakaba 1.3 }
3931 wakaba 1.1
3932     ;
3933     $__attrs->{''}->{$name}
3934     =
3935     $__anode->{'id'}
3936     ;
3937    
3938    
3939     {
3940    
3941    
3942     $__anode->{
3943     'b'
3944     }->{${$__anode->{
3945     'id'
3946     }}}
3947     ->{'owner'} = $self->{
3948     'id'
3949     };
3950    
3951    
3952 wakaba 1.3 }
3953 wakaba 1.1
3954     ;
3955    
3956    
3957    
3958 wakaba 1.3 }
3959 wakaba 1.1
3960    
3961     ;}
3962    
3963     ;
3964    
3965    
3966     {
3967    
3968    
3969     ## NOTE: The |cfg:xml-id| configuration parameter does not matter
3970     ## since it can be typed in the |createAttribute| method.
3971    
3972    
3973    
3974     {
3975    
3976     local $Error::Depth = $Error::Depth + 1;
3977    
3978     {
3979    
3980    
3981 wakaba 1.3 if
3982     ($od->
3983     dom_config
3984    
3985     ->
3986     get_parameter
3987    
3988     (
3989     'http://suika.fam.cx/www/2006/dom-config/dtd-attribute-type'
3990     )) {
3991     my $__st_doctype = $od->
3992 wakaba 1.1 doctype
3993     ;
3994 wakaba 1.3 $__st_doctype = $__st_doctype->
3995 wakaba 1.1 get_feature
3996    
3997 wakaba 1.3 (
3998 wakaba 1.1 'http://suika.fam.cx/www/2006/feature/XDoctype'
3999     => '3.0')
4000 wakaba 1.3 if defined $__st_doctype;
4001     if (defined $__st_doctype) {
4002     my $__st_et = $__st_doctype->
4003 wakaba 1.1 get_element_type_definition_node
4004    
4005 wakaba 1.3 ($self->
4006 wakaba 1.1 node_name
4007     );
4008 wakaba 1.3 if (defined $__st_et) {
4009     my $__st_at = $__st_et->
4010 wakaba 1.1 get_attribute_definition_node
4011    
4012 wakaba 1.3 ($name);
4013     if (defined $__st_at) {
4014     $__anode->
4015 wakaba 1.1 manakai_attribute_type
4016    
4017 wakaba 1.3 ($__st_at->
4018 wakaba 1.1 declared_type
4019     );
4020 wakaba 1.3 }
4021 wakaba 1.1 }
4022     }
4023     }
4024    
4025    
4026    
4027 wakaba 1.3 }
4028 wakaba 1.1
4029    
4030     ;}
4031    
4032     ;
4033    
4034    
4035 wakaba 1.3 }
4036 wakaba 1.1
4037     ;
4038     }
4039    
4040    
4041     {
4042    
4043     local $Error::Depth = $Error::Depth + 1;
4044    
4045     {
4046    
4047    
4048    
4049     $__anode->
4050     value
4051     ($value);
4052     $__anode->
4053     specified
4054     (
4055     1
4056     );
4057    
4058    
4059    
4060 wakaba 1.3 }
4061 wakaba 1.1
4062    
4063     ;}
4064    
4065     ;
4066    
4067    
4068 wakaba 1.3 }
4069 wakaba 1.1 }
4070     sub set_attribute_ns ($$$$) {
4071     my ($self, $namespaceURI, $qualifiedName, $value) = @_;
4072    
4073     {
4074    
4075     if
4076     (CORE::defined $namespaceURI and CORE::length $namespaceURI == 0) {
4077 wakaba 1.9 require Message::DOM::DOMMain;
4078 wakaba 1.1
4079 wakaba 1.12 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:1165118814:1861:wAUT122229+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest';
4080 wakaba 1.1
4081     ;
4082    
4083    
4084    
4085     {
4086    
4087    
4088     $namespaceURI = undef;
4089    
4090    
4091    
4092 wakaba 1.3 }
4093 wakaba 1.1
4094     ;
4095     }
4096    
4097    
4098 wakaba 1.3 }
4099 wakaba 1.1
4100     {
4101    
4102     my
4103     ($prefix, $localName) = ref $qualifiedName eq 'ARRAY'
4104     ? @$qualifiedName
4105     : split /:/, $qualifiedName, 2;
4106     ($prefix, $localName) = (
4107     undef
4108     , $prefix) unless defined $localName;
4109    
4110     my $od = $self->
4111     owner_document
4112     ;
4113     if ($od->
4114     strict_error_checking
4115     ) {
4116     if ($self->
4117     manakai_read_only
4118     ) {
4119    
4120     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';
4121    
4122     ;
4123     }
4124     my $version = $od->
4125     xml_version
4126     ;
4127     $qualifiedName = defined $prefix ? $prefix.':'.$localName
4128     : $localName;
4129    
4130    
4131     {
4132    
4133     if
4134     (defined $version and $version eq '1.1') {
4135     unless (
4136     ($qualifiedName =~ /\A\p{InXMLNameStartChar11}\p{InXMLNameChar11}*\z/)
4137     ) {
4138    
4139     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';
4140    
4141     ;
4142     }
4143     unless (
4144     ($qualifiedName =~ /\A\p{InXMLNCNameStartChar11}\p{InXMLNCNameChar11}*(?::\p{InXMLNCNameStartChar11}\p{InXMLNCNameChar11}*)?\z/)
4145     ) {
4146    
4147     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';
4148    
4149     ;
4150     }
4151     } else {
4152     unless (
4153     ($qualifiedName =~ /\A\p{InXML_NameStartChar10}\p{InXMLNameChar10}*\z/)
4154     ) {
4155    
4156     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';
4157    
4158     ;
4159     }
4160     unless (
4161     ($qualifiedName =~ /\A\p{InXML_NCNameStartChar10}\p{InXMLNCNameChar10}*(?::\p{InXML_NCNameStartChar10}\p{InXMLNCNameChar10}*)?\z/)
4162     ) {
4163    
4164     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';
4165    
4166     ;
4167     }
4168     }
4169    
4170    
4171 wakaba 1.3 }
4172 wakaba 1.1
4173     ;
4174    
4175    
4176     {
4177    
4178     if
4179     (defined $prefix) {
4180     if (not defined $namespaceURI) {
4181    
4182     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';
4183    
4184     ;
4185     } elsif ($prefix eq 'xml' and $namespaceURI ne
4186     'http://www.w3.org/XML/1998/namespace'
4187     ) {
4188    
4189     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';
4190    
4191     ;
4192     } elsif ($prefix eq 'xmlns' and $namespaceURI ne
4193     'http://www.w3.org/2000/xmlns/'
4194     ) {
4195    
4196     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';
4197    
4198     ;
4199     } elsif ($namespaceURI eq
4200     'http://www.w3.org/XML/1998/namespace' and
4201     $prefix ne 'xml') {
4202    
4203     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';
4204    
4205     ;
4206     } elsif ($namespaceURI eq
4207     'http://www.w3.org/2000/xmlns/' and
4208     $prefix ne 'xmlns') {
4209    
4210     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';
4211    
4212     ;
4213     }
4214     } else { ## No prefix
4215     if (not defined $namespaceURI) {
4216     #
4217     } elsif ($namespaceURI eq
4218     'http://www.w3.org/2000/xmlns/' and
4219     $localName ne 'xmlns') {
4220    
4221     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';
4222    
4223     ;
4224     }
4225     }
4226    
4227    
4228 wakaba 1.3 }
4229 wakaba 1.1
4230     ;
4231     }
4232    
4233    
4234     {
4235    
4236     my
4237     $__anode;
4238    
4239    
4240     {
4241    
4242     my
4243     $__attrs;
4244    
4245    
4246     {
4247    
4248    
4249     $__attrs = $self->{
4250     'b'
4251     }->{${$self->{
4252     'id'
4253     }}}
4254     ->{'attr'};
4255    
4256    
4257 wakaba 1.3 }
4258 wakaba 1.1
4259     ;
4260     if (defined $__attrs->{defined $namespaceURI ? $namespaceURI : ''}
4261     ->{$localName}) {
4262    
4263    
4264     {
4265    
4266    
4267     $__anode = ${($self->{'b'})->{${$__attrs->{defined $namespaceURI ? $namespaceURI : ''}
4268     ->{$localName}}}->{
4269     'cls'
4270     }}->___create_node_ref ({
4271    
4272     'id'
4273     => $__attrs->{defined $namespaceURI ? $namespaceURI : ''}
4274     ->{$localName},
4275    
4276     'b'
4277     => ($self->{'b'}),
4278     }, {
4279     });
4280     ($self->{'b'})->{${$__attrs->{defined $namespaceURI ? $namespaceURI : ''}
4281     ->{$localName}}}->{
4282     'rc'
4283     }++;
4284    
4285    
4286 wakaba 1.3 }
4287 wakaba 1.1
4288     ;
4289     }
4290    
4291    
4292 wakaba 1.3 }
4293 wakaba 1.1
4294     ;
4295     if (defined $__anode) { ## There is already a node with such a |name|
4296     if ($__anode->
4297     manakai_read_only
4298     ) {
4299    
4300     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;
4301    
4302     ;
4303     }
4304     $__anode->
4305     prefix
4306     ($prefix) if defined $prefix;
4307     ## ISSUE: Should NULL be allowed here with |strictErrorChecking| off?
4308     } else { ## There is no such attribute
4309    
4310    
4311     {
4312    
4313     local $Error::Depth = $Error::Depth + 1;
4314    
4315     {
4316    
4317    
4318    
4319     $__anode = $od->
4320     create_attribute_ns
4321    
4322     ($namespaceURI, [$prefix, $localName]);
4323     my $__attrs;
4324    
4325    
4326     {
4327    
4328    
4329     $__attrs = $self->{
4330     'b'
4331     }->{${$self->{
4332     'id'
4333     }}}
4334     ->{'attr'};
4335    
4336    
4337 wakaba 1.3 }
4338 wakaba 1.1
4339     ;
4340     $__attrs->{defined $namespaceURI ? $namespaceURI : ''}->{$localName}
4341     =
4342     $__anode->{'id'}
4343     ;
4344    
4345    
4346     {
4347    
4348    
4349     $__anode->{
4350     'b'
4351     }->{${$__anode->{
4352     'id'
4353     }}}
4354     ->{'owner'} = $self->{
4355     'id'
4356     };
4357    
4358    
4359 wakaba 1.3 }
4360 wakaba 1.1
4361     ;
4362    
4363    
4364    
4365 wakaba 1.3 }
4366 wakaba 1.1
4367    
4368     ;}
4369    
4370     ;
4371    
4372    
4373     {
4374    
4375    
4376     ## NOTE: The |cfg:xml-id| configuration parameter does not matter
4377     ## since it can be typed in the |createAttribute| method.
4378    
4379    
4380    
4381     {
4382    
4383     local $Error::Depth = $Error::Depth + 1;
4384    
4385     {
4386    
4387    
4388 wakaba 1.3 if
4389     ($od->
4390     dom_config
4391    
4392     ->
4393     get_parameter
4394    
4395     (
4396     'http://suika.fam.cx/www/2006/dom-config/dtd-attribute-type'
4397     )) {
4398     my $__st_doctype = $od->
4399 wakaba 1.1 doctype
4400     ;
4401 wakaba 1.3 $__st_doctype = $__st_doctype->
4402 wakaba 1.1 get_feature
4403    
4404 wakaba 1.3 (
4405 wakaba 1.1 'http://suika.fam.cx/www/2006/feature/XDoctype'
4406     => '3.0')
4407 wakaba 1.3 if defined $__st_doctype;
4408     if (defined $__st_doctype) {
4409     my $__st_et = $__st_doctype->
4410 wakaba 1.1 get_element_type_definition_node
4411    
4412 wakaba 1.3 ($self->
4413 wakaba 1.1 node_name
4414     );
4415 wakaba 1.3 if (defined $__st_et) {
4416     my $__st_at = $__st_et->
4417 wakaba 1.1 get_attribute_definition_node
4418    
4419 wakaba 1.3 (defined $prefix ? $prefix.':'.$localName
4420 wakaba 1.1 : $localName);
4421 wakaba 1.3 if (defined $__st_at) {
4422     $__anode->
4423 wakaba 1.1 manakai_attribute_type
4424    
4425 wakaba 1.3 ($__st_at->
4426 wakaba 1.1 declared_type
4427     );
4428 wakaba 1.3 }
4429 wakaba 1.1 }
4430     }
4431     }
4432    
4433    
4434    
4435 wakaba 1.3 }
4436 wakaba 1.1
4437    
4438     ;}
4439    
4440     ;
4441    
4442    
4443 wakaba 1.3 }
4444 wakaba 1.1
4445     ;
4446     }
4447    
4448    
4449     {
4450    
4451     local $Error::Depth = $Error::Depth + 1;
4452    
4453     {
4454    
4455    
4456    
4457     $__anode->
4458     value
4459     (defined $value ? $value : '');
4460     $__anode->
4461     specified
4462     (
4463     1
4464     );
4465    
4466    
4467    
4468 wakaba 1.3 }
4469 wakaba 1.1
4470    
4471     ;}
4472    
4473     ;
4474    
4475    
4476 wakaba 1.3 }
4477 wakaba 1.1
4478     ;
4479    
4480    
4481 wakaba 1.3 }
4482 wakaba 1.1 }
4483     sub set_attribute_node ($$) {
4484     my ($self, $newAttr) = @_;
4485     my $r;
4486    
4487     {
4488    
4489     my
4490     $self_od = $self->
4491     owner_document
4492     ;
4493     my $strict = $self_od->
4494     strict_error_checking
4495     ;
4496     if ($strict and
4497     not $self_od eq $newAttr->
4498     owner_document
4499     ) {
4500    
4501     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;
4502    
4503     ;
4504     }
4505    
4506     my $nsuri = $newAttr->
4507     namespace_uri
4508     ;
4509     $nsuri = '' unless defined $nsuri;
4510     my $ln = $newAttr->
4511     local_name
4512     ;
4513     my $attrs;
4514    
4515    
4516     {
4517    
4518    
4519     $attrs = $self->{
4520     'b'
4521     }->{${$self->{
4522     'id'
4523     }}}
4524     ->{'attr'};
4525    
4526    
4527 wakaba 1.3 }
4528 wakaba 1.1
4529     ;
4530     my $current;
4531     if (defined $attrs->{$nsuri}->{$ln}) {
4532    
4533    
4534     {
4535    
4536    
4537     $current = ${($self->{'b'})->{${$attrs->{$nsuri}->{$ln}}}->{
4538     'cls'
4539     }}->___create_node_ref ({
4540    
4541     'id'
4542     => $attrs->{$nsuri}->{$ln},
4543    
4544     'b'
4545     => ($self->{'b'}),
4546     }, {
4547     });
4548     ($self->{'b'})->{${$attrs->{$nsuri}->{$ln}}}->{
4549     'rc'
4550     }++;
4551    
4552    
4553 wakaba 1.3 }
4554 wakaba 1.1
4555     ;
4556     }
4557    
4558     if (defined $newAttr->
4559     owner_element
4560     ) {
4561     if (defined $current and $current eq $newAttr) {
4562    
4563     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';
4564    
4565     ;
4566     ## No return value
4567     } else {
4568    
4569     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;
4570    
4571     ;
4572     }
4573     } else { # not in use
4574     if ($strict and $self->
4575     manakai_read_only
4576     ) {
4577    
4578     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';
4579    
4580     ;
4581     }
4582    
4583     $attrs->{$nsuri}->{$ln} =
4584     $newAttr->{'id'}
4585     ;
4586    
4587    
4588     {
4589    
4590    
4591     $newAttr->{
4592     'b'
4593     }->{${$newAttr->{
4594     'id'
4595     }}}
4596     ->{'owner'} = $self->{
4597     'id'
4598     };
4599    
4600    
4601 wakaba 1.3 }
4602 wakaba 1.1
4603     ;
4604     $newAttr->
4605     specified
4606     (
4607     1
4608     );
4609    
4610     if (defined $current) {
4611    
4612    
4613     {
4614    
4615     CORE::delete
4616     $current->{
4617     'b'
4618     }->{${$current->{
4619     'id'
4620     }}}
4621     ->{'owner'};
4622    
4623    
4624 wakaba 1.3 }
4625 wakaba 1.1
4626     ;
4627     $r = $current;
4628     }
4629     }
4630    
4631    
4632 wakaba 1.3 }
4633 wakaba 1.1 $r}
4634     sub set_attribute_node_ns ($$) {
4635     my ($self, $newAttr) = @_;
4636     my $r;
4637    
4638     {
4639    
4640     my
4641     $self_od = $self->
4642     owner_document
4643     ;
4644     my $strict = $self_od->
4645     strict_error_checking
4646     ;
4647     if ($strict and
4648     not $self_od eq $newAttr->
4649     owner_document
4650     ) {
4651    
4652     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;
4653    
4654     ;
4655     }
4656    
4657     my $nsuri = $newAttr->
4658     namespace_uri
4659     ;
4660     $nsuri = '' unless defined $nsuri;
4661     my $ln = $newAttr->
4662     local_name
4663     ;
4664     my $attrs;
4665    
4666    
4667     {
4668    
4669    
4670     $attrs = $self->{
4671     'b'
4672     }->{${$self->{
4673     'id'
4674     }}}
4675     ->{'attr'};
4676    
4677    
4678 wakaba 1.3 }
4679 wakaba 1.1
4680     ;
4681     my $current;
4682     if (defined $attrs->{$nsuri}->{$ln}) {
4683    
4684    
4685     {
4686    
4687    
4688     $current = ${($self->{'b'})->{${$attrs->{$nsuri}->{$ln}}}->{
4689     'cls'
4690     }}->___create_node_ref ({
4691    
4692     'id'
4693     => $attrs->{$nsuri}->{$ln},
4694    
4695     'b'
4696     => ($self->{'b'}),
4697     }, {
4698     });
4699     ($self->{'b'})->{${$attrs->{$nsuri}->{$ln}}}->{
4700     'rc'
4701     }++;
4702    
4703    
4704 wakaba 1.3 }
4705 wakaba 1.1
4706     ;
4707     }
4708    
4709     if (defined $newAttr->
4710     owner_element
4711     ) {
4712     if (defined $current and $current eq $newAttr) {
4713    
4714     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';
4715    
4716     ;
4717     ## No return value
4718     } else {
4719    
4720     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;
4721    
4722     ;
4723     }
4724     } else { # not in use
4725     if ($strict and $self->
4726     manakai_read_only
4727     ) {
4728    
4729     report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#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';
4730    
4731     ;
4732     }
4733    
4734     $attrs->{$nsuri}->{$ln} =
4735     $newAttr->{'id'}
4736     ;
4737    
4738    
4739     {
4740    
4741    
4742     $newAttr->{
4743     'b'
4744     }->{${$newAttr->{
4745     'id'
4746     }}}
4747     ->{'owner'} = $self->{
4748     'id'
4749     };
4750    
4751    
4752 wakaba 1.3 }
4753 wakaba 1.1
4754     ;
4755     $newAttr->
4756     specified
4757     (
4758     1
4759     );
4760    
4761     if (defined $current) {
4762    
4763    
4764     {
4765    
4766     CORE::delete
4767     $current->{
4768     'b'
4769     }->{${$current->{
4770     'id'
4771     }}}
4772     ->{'owner'};
4773    
4774    
4775 wakaba 1.3 }
4776 wakaba 1.1
4777     ;
4778     $r = $current;
4779     }
4780     }
4781    
4782    
4783 wakaba 1.3 }
4784 wakaba 1.1 $r}
4785     sub remove_attribute ($$) {
4786     my ($self, $name) = @_;
4787    
4788     {
4789    
4790     my
4791     $list;
4792     my $key;
4793     my $attr;
4794    
4795    
4796     {
4797    
4798     my
4799     $__attr;
4800    
4801    
4802     {
4803    
4804    
4805     $__attr = $self->{
4806     'b'
4807     }->{${$self->{
4808     'id'
4809     }}}
4810     ->{'attr'};
4811    
4812    
4813 wakaba 1.3 }
4814 wakaba 1.1
4815     ;
4816    
4817     ## Note that we no longer support DOM Level 1 nodes.
4818    
4819     ## If an attribute's qualified name is equal to
4820     ## the requested name, then the node is the answer.
4821    
4822     ## Note that if there is a namespace ill-formed attribute,
4823     ## the result is not the expected one. For example,
4824     ## if an |xmlns| attribute in the |http://www.w3.org/2000/xmlns/|
4825     ## namespace has non-NULL |prefix|, a request to get |xmlns|
4826     ## attribute will not return that node.
4827    
4828     ## |sort|ing is required so that every |getAttribute|, |setAttribute|,
4829     ## |hasAttribute|, |removeAttribute|, or any other namespace unaware
4830     ## methods operates on the same node even if there is
4831     ## multiple nodes with the same qualified name.
4832    
4833     NS: for my $__ns (sort {$a cmp $b} keys %$__attr) {
4834     for my $__ln (sort {$a cmp $b} keys %{$__attr->{$__ns}}) {
4835     my $__node;
4836    
4837    
4838     {
4839    
4840    
4841     $__node = ${($self->{'b'})->{${$__attr->{$__ns}->{$__ln}}}->{
4842     'cls'
4843     }}->___create_node_ref ({
4844    
4845     'id'
4846     => $__attr->{$__ns}->{$__ln},
4847    
4848     'b'
4849     => ($self->{'b'}),
4850     }, {
4851     });
4852     ($self->{'b'})->{${$__attr->{$__ns}->{$__ln}}}->{
4853     'rc'
4854     }++;
4855    
4856    
4857 wakaba 1.3 }
4858 wakaba 1.1
4859     ;
4860     if ($__node->
4861     node_name eq
4862     $name) {
4863    
4864    
4865     ;
4866    
4867    
4868     {
4869    
4870    
4871     $attr = $__node;
4872     $list = $__attr->{$__ns};
4873     $key = $__ln;
4874    
4875    
4876    
4877 wakaba 1.3 }
4878 wakaba 1.1
4879     ;
4880     last NS;
4881     }
4882     } # ln
4883     } # NS
4884    
4885    
4886 wakaba 1.3 }
4887 wakaba 1.1
4888     ;
4889     if (defined $attr) {
4890     if ($self->
4891     manakai_read_only
4892     ) {
4893    
4894     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';
4895    
4896     ;
4897     }
4898    
4899     ## Remove the attribute node
4900     CORE::delete $list->{$key};
4901    
4902    
4903     {
4904    
4905     CORE::delete
4906     $attr->{
4907     'b'
4908     }->{${$attr->{
4909     'id'
4910     }}}
4911     ->{'owner'};
4912    
4913    
4914 wakaba 1.3 }
4915 wakaba 1.1
4916     ;
4917    
4918     ## Default attribute
4919     my $doc = $self->
4920     owner_document
4921     ;
4922 wakaba 1.3 my $doc_cfg = $doc->
4923     dom_config
4924     ;
4925     if ($doc_cfg->
4926     get_parameter
4927    
4928     (
4929     'http://suika.fam.cx/www/2006/dom-config/dtd-default-attribute'
4930     )) {
4931     my $prefix;
4932    
4933 wakaba 1.1
4934     {
4935    
4936    
4937     {
4938    
4939     local $Error::Depth = $Error::Depth + 1;
4940    
4941     {
4942    
4943    
4944     my
4945     $__doctype = $doc->
4946     doctype
4947     ;
4948     $__doctype = $__doctype->
4949     get_feature
4950     (
4951     'http://suika.fam.cx/www/2006/feature/XDoctype'
4952     )
4953     if $__doctype;
4954     if (defined $__doctype) {
4955     my $__et = $__doctype->
4956     get_element_type_definition_node
4957    
4958     ($self->node_name);
4959     if (defined $__et) {
4960     my $__orig_strict = $doc->
4961     strict_error_checking
4962     ;
4963     $doc->
4964     strict_error_checking
4965     (
4966     0
4967     );
4968    
4969     my $__at = $__et->
4970     get_attribute_definition_node
4971     ($name);
4972     if (defined $__at) {
4973 wakaba 1.3 my $__copy_asis = $doc_cfg->
4974 wakaba 1.1 get_parameter
4975    
4976     (
4977     'http://suika.fam.cx/www/2006/dom-config/clone-entity-reference-subtree'
4978     );
4979 wakaba 1.3 $doc_cfg->
4980 wakaba 1.1 set_parameter
4981    
4982     (
4983     'http://suika.fam.cx/www/2006/dom-config/clone-entity-reference-subtree'
4984     =>
4985     1
4986     );
4987     ADD: {
4988     my $__attr;
4989     my $__attrs;
4990    
4991    
4992     {
4993    
4994    
4995     $__attrs = $self->{
4996     'b'
4997     }->{${$self->{
4998     'id'
4999     }}}
5000     ->{'attr'};
5001    
5002    
5003 wakaba 1.3 }
5004 wakaba 1.1
5005     ;
5006     if (defined $prefix) { ## prefixed attr
5007     my $__nsuri = $self->
5008     lookup_namespace_uri
5009    
5010     ($prefix);
5011     unless (defined $__nsuri) {
5012     ## TODO: Namespace well-formedness error
5013     }
5014     if (defined $__attrs->{defined $__nsuri ? $__nsuri : ''}
5015     ->{$name}) {
5016     ## TODO: Namespace well-formedness warning?
5017     last ADD;
5018     }
5019     $__attr = $doc->
5020     create_attribute_ns
5021    
5022     ($__nsuri, [$prefix, $name]);
5023     } else { ## local attr
5024     if ($name eq 'xmlns') {
5025     if (defined $__attrs->{
5026     'http://www.w3.org/2000/xmlns/'
5027     }->{xmlns}) {
5028     ## TODO: Namespace well-formedness warning?
5029     last ADD;
5030     }
5031     $__attr = $doc->
5032     create_attribute_ns
5033    
5034     (
5035     'http://www.w3.org/2000/xmlns/'
5036     , 'xmlns');
5037     } else {
5038     if (defined $__attrs->{''}->{$name}) {
5039     ## TODO: Namespace well-formedness warning?
5040     last ADD;
5041     }
5042     $__attr = $doc->
5043     create_attribute
5044     ($name);
5045     }
5046     }
5047     for my $__at_child (@{$__at->
5048     child_nodes
5049     }) {
5050     $__attr->
5051     append_child
5052    
5053     ($__at_child->
5054     clone_node
5055     (
5056     1
5057     ));
5058     }
5059     $__attr->
5060     manakai_attribute_type
5061    
5062     ($__at->
5063     declared_type
5064     );
5065     $self->
5066     set_attribute_node_ns
5067     ($__attr);
5068     ## This method change the |specified| flag
5069     $__attr->
5070     specified
5071     (
5072     0
5073     );
5074     } # ADD
5075 wakaba 1.3 $doc_cfg->
5076 wakaba 1.1 set_parameter
5077    
5078     (
5079     'http://suika.fam.cx/www/2006/dom-config/clone-entity-reference-subtree'
5080     => $__copy_asis);
5081     }
5082     $doc->
5083     strict_error_checking
5084     ($__orig_strict);
5085     } # et
5086     } # doctype
5087    
5088    
5089    
5090 wakaba 1.3 }
5091 wakaba 1.1
5092    
5093     ;}
5094    
5095     ;
5096    
5097    
5098 wakaba 1.3 }
5099 wakaba 1.1
5100     ;
5101 wakaba 1.3 }
5102 wakaba 1.1 } # exists
5103    
5104    
5105 wakaba 1.3 }
5106 wakaba 1.1 }
5107     sub remove_attribute_ns ($$$) {
5108     my ($self, $namespaceURI, $localName) = @_;
5109    
5110     {
5111    
5112     if
5113     (CORE::defined $namespaceURI and CORE::length $namespaceURI == 0) {
5114 wakaba 1.9 require Message::DOM::DOMMain;
5115 wakaba 1.1
5116 wakaba 1.12 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:1165118814:1861:wAUT122229+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest';
5117 wakaba 1.1
5118     ;
5119    
5120    
5121    
5122     {
5123    
5124    
5125     $namespaceURI = undef;
5126    
5127    
5128    
5129 wakaba 1.3 }
5130 wakaba 1.1
5131     ;
5132     }
5133    
5134    
5135 wakaba 1.3 }
5136 wakaba 1.1
5137     {
5138    
5139     my
5140     $list;
5141     my $attr;
5142    
5143    
5144     {
5145    
5146     my
5147     $__attrs;
5148    
5149    
5150     {
5151    
5152    
5153     $__attrs = $self->{
5154     'b'
5155     }->{${$self->{
5156     'id'
5157     }}}
5158     ->{'attr'};
5159    
5160    
5161 wakaba 1.3 }
5162 wakaba 1.1
5163     ;
5164     $list = $__attrs->{defined $namespaceURI ? $namespaceURI : ''};
5165 wakaba 1.5 if (defined $list and defined $list->{$localName}) {
5166 wakaba 1.1
5167    
5168     {
5169    
5170    
5171     $attr = ${($self->{'b'})->{${$__attrs->{defined $namespaceURI ? $namespaceURI : ''}
5172     ->{$localName}}}->{
5173     'cls'
5174     }}->___create_node_ref ({
5175    
5176     'id'
5177     => $__attrs->{defined $namespaceURI ? $namespaceURI : ''}
5178     ->{$localName},
5179    
5180     'b'
5181     => ($self->{'b'}),
5182     }, {
5183     });
5184     ($self->{'b'})->{${$__attrs->{defined $namespaceURI ? $namespaceURI : ''}
5185     ->{$localName}}}->{
5186     'rc'
5187     }++;
5188    
5189    
5190 wakaba 1.3 }
5191 wakaba 1.1
5192     ;
5193     }
5194    
5195    
5196 wakaba 1.3 }
5197 wakaba 1.1
5198     ;
5199     if (defined $attr) {
5200     if ($self->
5201     manakai_read_only
5202     ) {
5203    
5204     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';
5205    
5206     ;
5207     }
5208    
5209     ## Removes the attribute node
5210     CORE::delete $list->{$localName};
5211    
5212    
5213     {
5214    
5215     CORE::delete
5216     $attr->{
5217     'b'
5218     }->{${$attr->{
5219     'id'
5220     }}}
5221     ->{'owner'};
5222    
5223    
5224 wakaba 1.3 }
5225 wakaba 1.1
5226     ;
5227    
5228     ## Default attribute
5229     my $doc = $self->
5230     owner_document
5231     ;
5232 wakaba 1.3 my $doc_cfg = $doc->
5233     dom_config
5234     ;
5235     if ($doc_cfg->
5236     get_parameter
5237    
5238     (
5239     'http://suika.fam.cx/www/2006/dom-config/dtd-default-attribute'
5240     )) {
5241     my $pfx = $attr->
5242     prefix
5243     ;
5244     my $name = defined $pfx ? $pfx.':'.$localName : $localName;
5245    
5246 wakaba 1.1
5247     {
5248    
5249    
5250     {
5251    
5252     local $Error::Depth = $Error::Depth + 1;
5253    
5254     {
5255    
5256    
5257     my
5258     $__doctype = $doc->
5259     doctype
5260     ;
5261     $__doctype = $__doctype->
5262     get_feature
5263     (
5264     'http://suika.fam.cx/www/2006/feature/XDoctype'
5265     )
5266     if $__doctype;
5267     if (defined $__doctype) {
5268     my $__et = $__doctype->
5269     get_element_type_definition_node
5270    
5271     ($self->node_name);
5272     if (defined $__et) {
5273     my $__orig_strict = $doc->
5274     strict_error_checking
5275     ;
5276     $doc->
5277     strict_error_checking
5278     (
5279     0
5280     );
5281    
5282     my $__at = $__et->
5283     get_attribute_definition_node
5284     ($name);
5285     if (defined $__at) {
5286 wakaba 1.3 my $__copy_asis = $doc_cfg->
5287 wakaba 1.1 get_parameter
5288    
5289     (
5290     'http://suika.fam.cx/www/2006/dom-config/clone-entity-reference-subtree'
5291     );
5292 wakaba 1.3 $doc_cfg->
5293 wakaba 1.1 set_parameter
5294    
5295     (
5296     'http://suika.fam.cx/www/2006/dom-config/clone-entity-reference-subtree'
5297     =>
5298     1
5299     );
5300     ADD: {
5301     my $__attr;
5302     my $__attrs;
5303    
5304    
5305     {
5306    
5307    
5308     $__attrs = $self->{
5309     'b'
5310     }->{${$self->{
5311     'id'
5312     }}}
5313     ->{'attr'};
5314    
5315    
5316 wakaba 1.3 }
5317 wakaba 1.1
5318     ;
5319     if (defined $pfx) { ## prefixed attr
5320     my $__nsuri = $self->
5321     lookup_namespace_uri
5322    
5323     ($pfx);
5324     unless (defined $__nsuri) {
5325     ## TODO: Namespace well-formedness error
5326     }
5327     if (defined $__attrs->{defined $__nsuri ? $__nsuri : ''}
5328     ->{$localName}) {
5329     ## TODO: Namespace well-formedness warning?
5330     last ADD;
5331     }
5332     $__attr = $doc->
5333     create_attribute_ns
5334    
5335     ($__nsuri, [$pfx, $localName]);
5336     } else { ## local attr
5337     if ($name eq 'xmlns') {
5338     if (defined $__attrs->{
5339     'http://www.w3.org/2000/xmlns/'
5340     }->{xmlns}) {
5341     ## TODO: Namespace well-formedness warning?
5342     last ADD;
5343     }
5344     $__attr = $doc->
5345     create_attribute_ns
5346    
5347     (
5348     'http://www.w3.org/2000/xmlns/'
5349     , 'xmlns');
5350     } else {
5351     if (defined $__attrs->{''}->{$name}) {
5352     ## TODO: Namespace well-formedness warning?
5353     last ADD;
5354     }
5355     $__attr = $doc->
5356     create_attribute
5357     ($name);
5358     }
5359     }
5360     for my $__at_child (@{$__at->
5361     child_nodes
5362     }) {
5363     $__attr->
5364     append_child
5365    
5366     ($__at_child->
5367     clone_node
5368     (
5369     1
5370     ));
5371     }
5372     $__attr->
5373     manakai_attribute_type
5374    
5375     ($__at->
5376     declared_type
5377     );
5378     $self->
5379     set_attribute_node_ns
5380     ($__attr);
5381     ## This method change the |specified| flag
5382     $__attr->
5383     specified
5384     (
5385     0
5386     );
5387     } # ADD
5388 wakaba 1.3 $doc_cfg->
5389 wakaba 1.1 set_parameter
5390    
5391     (
5392     'http://suika.fam.cx/www/2006/dom-config/clone-entity-reference-subtree'
5393     => $__copy_asis);
5394     }
5395     $doc->
5396     strict_error_checking
5397     ($__orig_strict);
5398     } # et
5399     } # doctype
5400    
5401    
5402    
5403 wakaba 1.3 }
5404 wakaba 1.1
5405    
5406     ;}
5407    
5408     ;
5409    
5410    
5411 wakaba 1.3 }
5412 wakaba 1.1
5413     ;
5414 wakaba 1.3 }
5415 wakaba 1.1 } # exists
5416    
5417    
5418 wakaba 1.3 }
5419 wakaba 1.1 }
5420     sub remove_attribute_node ($$) {
5421     my ($self, $oldAttr) = @_;
5422     my $r;
5423    
5424     {
5425    
5426     my
5427     $od = $self->
5428     owner_document
5429     ;
5430     if ($od->
5431     strict_error_checking and
5432    
5433     $self->
5434     manakai_read_only
5435     ) {
5436    
5437     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';
5438    
5439     ;
5440     }
5441    
5442     my $ln = $oldAttr->
5443     local_name
5444     ;
5445     FIND: {
5446     my $attrs;
5447    
5448    
5449     {
5450    
5451    
5452     $attrs = $self->{
5453     'b'
5454     }->{${$self->{
5455     'id'
5456     }}}
5457     ->{'attr'};
5458    
5459    
5460 wakaba 1.3 }
5461 wakaba 1.1
5462     ;
5463     my $nsuri = $oldAttr->
5464     namespace_uri
5465     ;
5466     my $list = $attrs->{defined $nsuri ? $nsuri : ''};
5467     my $list_nid = $list->{$ln};
5468     if (defined $list_nid and
5469    
5470     (${$oldAttr->{'id'}} eq ${$list_nid})
5471     ) {
5472     CORE::delete $list->{$ln};
5473     last FIND;
5474     }
5475    
5476     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;
5477    
5478     ;
5479     } # FIND
5480    
5481    
5482    
5483     {
5484    
5485     CORE::delete
5486     $oldAttr->{
5487     'b'
5488     }->{${$oldAttr->{
5489     'id'
5490     }}}
5491     ->{'owner'};
5492    
5493    
5494 wakaba 1.3 }
5495 wakaba 1.1
5496     ;
5497     $r = $oldAttr;
5498    
5499     ## Default attribute
5500 wakaba 1.3 my $doc_cfg = $od->
5501     dom_config
5502     ;
5503     if ($doc_cfg->
5504     get_parameter
5505    
5506     (
5507     'http://suika.fam.cx/www/2006/dom-config/dtd-default-attribute'
5508     )) {
5509     my $name = $oldAttr->
5510 wakaba 1.1 node_name
5511     ;
5512 wakaba 1.3 my $pfx = $oldAttr->
5513 wakaba 1.1 prefix
5514     ;
5515 wakaba 1.3
5516 wakaba 1.1
5517     {
5518    
5519    
5520     {
5521    
5522     local $Error::Depth = $Error::Depth + 1;
5523    
5524     {
5525    
5526    
5527     my
5528     $__doctype = $od->
5529     doctype
5530     ;
5531     $__doctype = $__doctype->
5532     get_feature
5533     (
5534     'http://suika.fam.cx/www/2006/feature/XDoctype'
5535     )
5536     if $__doctype;
5537     if (defined $__doctype) {
5538     my $__et = $__doctype->
5539     get_element_type_definition_node
5540    
5541     ($self->node_name);
5542     if (defined $__et) {
5543     my $__orig_strict = $od->
5544     strict_error_checking
5545     ;
5546     $od->
5547     strict_error_checking
5548     (
5549     0
5550     );
5551    
5552     my $__at = $__et->
5553     get_attribute_definition_node
5554     ($name);
5555     if (defined $__at) {
5556 wakaba 1.3 my $__copy_asis = $doc_cfg->
5557 wakaba 1.1 get_parameter
5558    
5559     (
5560     'http://suika.fam.cx/www/2006/dom-config/clone-entity-reference-subtree'
5561     );
5562 wakaba 1.3 $doc_cfg->
5563 wakaba 1.1 set_parameter
5564    
5565     (
5566     'http://suika.fam.cx/www/2006/dom-config/clone-entity-reference-subtree'
5567     =>
5568     1
5569     );
5570     ADD: {
5571     my $__attr;
5572     my $__attrs;
5573    
5574    
5575     {
5576    
5577    
5578     $__attrs = $self->{
5579     'b'
5580     }->{${$self->{
5581     'id'
5582     }}}
5583     ->{'attr'};
5584    
5585    
5586 wakaba 1.3 }
5587 wakaba 1.1
5588     ;
5589     if (defined $pfx) { ## prefixed attr
5590     my $__nsuri = $self->
5591     lookup_namespace_uri
5592    
5593     ($pfx);
5594     unless (defined $__nsuri) {
5595     ## TODO: Namespace well-formedness error
5596     }
5597     if (defined $__attrs->{defined $__nsuri ? $__nsuri : ''}
5598     ->{$ln}) {
5599     ## TODO: Namespace well-formedness warning?
5600     last ADD;
5601     }
5602     $__attr = $od->
5603     create_attribute_ns
5604    
5605     ($__nsuri, [$pfx, $ln]);
5606     } else { ## local attr
5607     if ($name eq 'xmlns') {
5608     if (defined $__attrs->{
5609     'http://www.w3.org/2000/xmlns/'
5610     }->{xmlns}) {
5611     ## TODO: Namespace well-formedness warning?
5612     last ADD;
5613     }
5614     $__attr = $od->
5615     create_attribute_ns
5616    
5617     (
5618     'http://www.w3.org/2000/xmlns/'
5619     , 'xmlns');
5620     } else {
5621     if (defined $__attrs->{''}->{$name}) {
5622     ## TODO: Namespace well-formedness warning?
5623     last ADD;
5624     }
5625     $__attr = $od->
5626     create_attribute
5627     ($name);
5628     }
5629     }
5630     for my $__at_child (@{$__at->
5631     child_nodes
5632     }) {
5633     $__attr->
5634     append_child
5635    
5636     ($__at_child->
5637     clone_node
5638     (
5639     1
5640     ));
5641     }
5642     $__attr->
5643     manakai_attribute_type
5644    
5645     ($__at->
5646     declared_type
5647     );
5648     $self->
5649     set_attribute_node_ns
5650     ($__attr);
5651     ## This method change the |specified| flag
5652     $__attr->
5653     specified
5654     (
5655     0
5656     );
5657     } # ADD
5658 wakaba 1.3 $doc_cfg->
5659 wakaba 1.1 set_parameter
5660    
5661     (
5662     'http://suika.fam.cx/www/2006/dom-config/clone-entity-reference-subtree'
5663     => $__copy_asis);
5664     }
5665     $od->
5666     strict_error_checking
5667     ($__orig_strict);
5668     } # et
5669     } # doctype
5670    
5671    
5672    
5673 wakaba 1.3 }
5674 wakaba 1.1
5675    
5676     ;}
5677    
5678     ;
5679    
5680    
5681 wakaba 1.3 }
5682 wakaba 1.1
5683     ;
5684 wakaba 1.3 }
5685 wakaba 1.1
5686    
5687 wakaba 1.3 }
5688 wakaba 1.1 $r}
5689     sub schema_type_info ($;$) {
5690     if (@_ == 1) {my ($self) = @_;
5691     my $r;
5692    
5693     {
5694    
5695    
5696     {
5697    
5698     my
5699     $v = 0 || 0;
5700     $r = bless \$v,
5701 wakaba 1.10 'Message::DOM::Element::ManakaiDOMDTDTypeInfo'
5702 wakaba 1.1 ;
5703    
5704    
5705 wakaba 1.3 }
5706 wakaba 1.1
5707     ;
5708    
5709    
5710 wakaba 1.3 }
5711 wakaba 1.1 $r;
5712     } else {my ($self) = @_;
5713     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';
5714     }
5715     }
5716     sub get_elements_by_tag_name ($$) {
5717     my ($self, $name) = @_;
5718     my $r;
5719    
5720     {
5721    
5722    
5723     $name = "$name";
5724     my $chk;
5725     if ($name eq '*') {
5726     $chk = sub {
5727     1
5728     };
5729     } else {
5730     $chk = sub {
5731     my $node = shift;
5732     my $nodeName = $node->
5733     node_name
5734     ;
5735     ($nodeName eq $name);
5736     };
5737     }
5738    
5739    
5740     {
5741    
5742    
5743     $r = bless \[$self, $chk],
5744     'Message::DOM::TreeCore::ManakaiDOMGetElementsNodeList'
5745     ;
5746    
5747    
5748 wakaba 1.3 }
5749 wakaba 1.1
5750     ;
5751    
5752    
5753 wakaba 1.3 }
5754 wakaba 1.1 $r}
5755     sub get_elements_by_tag_name_ns ($$$) {
5756     my ($self, $namespaceURI, $localName) = @_;
5757    
5758     {
5759    
5760     if
5761     (CORE::defined $namespaceURI and CORE::length $namespaceURI == 0) {
5762 wakaba 1.9 require Message::DOM::DOMMain;
5763 wakaba 1.1
5764 wakaba 1.12 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:1165118814:1861:wAUT122229+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest';
5765 wakaba 1.1
5766     ;
5767    
5768    
5769    
5770     {
5771    
5772    
5773     $namespaceURI = undef;
5774    
5775    
5776    
5777 wakaba 1.3 }
5778 wakaba 1.1
5779     ;
5780     }
5781    
5782    
5783 wakaba 1.3 }
5784 wakaba 1.1 my $r;
5785    
5786     {
5787    
5788    
5789     $namespaceURI = "$namespaceURI" if defined $namespaceURI;
5790     $localName = "$localName";
5791     my $chk;
5792     if (not defined $namespaceURI) {
5793     if ($localName eq '*') {
5794     $chk = sub {
5795     my $node = shift;
5796     (not defined $node->
5797     namespace_uri
5798     );
5799     };
5800     } else {
5801     $chk = sub {
5802     my $node = shift;
5803     (not defined $node->
5804     namespace_uri and
5805    
5806     $node->
5807     local_name eq
5808     $localName);
5809     };
5810     }
5811     } elsif ($namespaceURI eq '*') {
5812     if ($localName eq '*') {
5813     $chk = sub {
5814     1
5815     };
5816     } else {
5817     $chk = sub {
5818     my $node = shift;
5819     ($node->
5820     local_name eq
5821     $localName);
5822     };
5823     }
5824     } else {
5825     if ($localName eq '*') {
5826     $chk = sub {
5827     my $node = shift;
5828     my $nsuri = $node->
5829     namespace_uri
5830     ;
5831     (defined $nsuri and $nsuri eq $namespaceURI);
5832     };
5833     } else {
5834     $chk = sub {
5835     my $node = shift;
5836     my $nsuri = $node->
5837     namespace_uri
5838     ;
5839     (defined $nsuri and $nsuri eq $namespaceURI and
5840     $node->
5841     local_name eq
5842     $localName);
5843     };
5844     }
5845     }
5846    
5847    
5848     {
5849    
5850    
5851     $r = bless \[$self, $chk],
5852     'Message::DOM::TreeCore::ManakaiDOMGetElementsNodeList'
5853     ;
5854    
5855    
5856 wakaba 1.3 }
5857 wakaba 1.1
5858     ;
5859    
5860    
5861 wakaba 1.3 }
5862 wakaba 1.1 $r}
5863     sub manakai_base_uri ($;$) {
5864     if (@_ == 1) {my ($self) = @_;
5865     my $r = '';
5866    
5867     {
5868    
5869    
5870     {
5871    
5872    
5873 wakaba 1.2 $r = $self->{
5874     'b'
5875     }->{${$self->{
5876     'id'
5877     }}}
5878     ->{'buri'};
5879 wakaba 1.1
5880    
5881 wakaba 1.3 }
5882 wakaba 1.1
5883     ;
5884    
5885    
5886 wakaba 1.3 }
5887 wakaba 1.1 $r;
5888     } else {my ($self, $given) = @_;
5889    
5890     {
5891    
5892    
5893     {
5894    
5895     if
5896     ($self->
5897     manakai_read_only
5898     ) {
5899    
5900     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';
5901    
5902     ;
5903     }
5904    
5905    
5906 wakaba 1.3 }
5907 wakaba 1.1
5908     ;
5909    
5910    
5911     {
5912    
5913    
5914     $self->{
5915     'b'
5916     }->{${$self->{
5917     'id'
5918     }}}
5919     ->{'buri'} = $given;
5920    
5921    
5922 wakaba 1.3 }
5923 wakaba 1.1
5924     ;
5925    
5926    
5927 wakaba 1.3 }
5928 wakaba 1.1 }
5929     }
5930     sub set_id_attribute ($$;$) {
5931     my ($self, $name, $isId) = @_;
5932    
5933     {
5934    
5935    
5936     {
5937    
5938     if
5939     ($self->
5940     manakai_read_only
5941     ) {
5942    
5943     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';
5944    
5945     ;
5946     }
5947    
5948    
5949 wakaba 1.3 }
5950 wakaba 1.1
5951     ;
5952     my $attr = $self->
5953     get_attribute_node
5954     ($name);
5955     if (not defined $attr) {
5956    
5957     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;
5958    
5959     ;
5960     } elsif ($attr->
5961     manakai_read_only
5962     ) {
5963    
5964     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;
5965    
5966     ;
5967     } else {
5968     $attr->
5969     is_id
5970     ($isId);
5971     }
5972    
5973    
5974 wakaba 1.3 }
5975 wakaba 1.1 }
5976     sub set_id_attribute_ns ($$$;$) {
5977     my ($self, $namespaceURI, $localName, $isId) = @_;
5978    
5979     {
5980    
5981     if
5982     (CORE::defined $namespaceURI and CORE::length $namespaceURI == 0) {
5983 wakaba 1.9 require Message::DOM::DOMMain;
5984 wakaba 1.1
5985 wakaba 1.12 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:1165118814:1861:wAUT122229+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest';
5986 wakaba 1.1
5987     ;
5988    
5989    
5990    
5991     {
5992    
5993    
5994     $namespaceURI = undef;
5995    
5996    
5997    
5998 wakaba 1.3 }
5999 wakaba 1.1
6000     ;
6001     }
6002    
6003    
6004 wakaba 1.3 }
6005 wakaba 1.1
6006     {
6007    
6008    
6009     {
6010    
6011     if
6012     ($self->
6013     manakai_read_only
6014     ) {
6015    
6016     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';
6017    
6018     ;
6019     }
6020    
6021    
6022 wakaba 1.3 }
6023 wakaba 1.1
6024     ;
6025     my $attr = $self->
6026     get_attribute_node_ns
6027    
6028     ($namespaceURI, $localName);
6029     if (not defined $attr) {
6030    
6031     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;
6032    
6033     ;
6034     } elsif ($attr->
6035     manakai_read_only
6036     ) {
6037    
6038     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;
6039    
6040     ;
6041     } else {
6042     $attr->
6043     is_id
6044     ($isId);
6045     }
6046    
6047    
6048 wakaba 1.3 }
6049 wakaba 1.1 }
6050     sub set_id_attribute_node ($$;$) {
6051     my ($self, $idAttr, $isId) = @_;
6052    
6053     {
6054    
6055    
6056     {
6057    
6058     if
6059     ($self->
6060     manakai_read_only
6061     ) {
6062    
6063     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';
6064    
6065     ;
6066     }
6067    
6068    
6069 wakaba 1.3 }
6070 wakaba 1.1
6071     ;
6072    
6073     my $owner = $idAttr->
6074     owner_element
6075     ;
6076     if (not defined $owner or not $owner eq $self) {
6077    
6078     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;
6079    
6080     ;
6081     } elsif ($idAttr->
6082     manakai_read_only
6083     ) {
6084    
6085     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;
6086    
6087     ;
6088     } else {
6089     $idAttr->
6090     is_id
6091     ($isId);
6092     }
6093    
6094    
6095 wakaba 1.3 }
6096 wakaba 1.1 }
6097     $Message::DOM::DOMFeature::ClassInfo->{q<Message::DOM::Element::ManakaiDOMElement>}->{has_feature} = {'core',
6098     {'',
6099     '1',
6100     '1.0',
6101     '1',
6102     '2.0',
6103     '1',
6104     '3.0',
6105     '1'},
6106     'xml',
6107     {'',
6108     '1',
6109     '1.0',
6110     '1',
6111     '2.0',
6112     '1',
6113     '3.0',
6114     '1'},
6115     'xmlversion',
6116     {'',
6117     '1',
6118     '1.0',
6119     '1',
6120     '1.1',
6121     '1'}};
6122     $Message::DOM::ClassPoint{q<Message::DOM::Element::ManakaiDOMElement>} = 14.1;
6123     $Message::DOM::DOMFeature::ClassInfo->{q<Message::DOM::Element::ManakaiDOMElement>}->{compat_class}->{q<Message::DOM::Element::ManakaiDOMElement>} = 1;
6124     $Message::Util::Grove::ClassProp{q<Message::DOM::Element::ManakaiDOMElement>} = {'o0',
6125     ['parent'],
6126     's1a',
6127     ['child'],
6128     's2hh',
6129     ['attr'],
6130     'w0',
6131     ['od']};
6132     package Message::DOM::IFLatest::Attr;
6133 wakaba 1.12 our $VERSION = 20061203.0432;
6134 wakaba 1.1 package Message::DOM::Element::ManakaiDOMAttr;
6135 wakaba 1.12 our $VERSION = 20061203.0432;
6136 wakaba 1.1 push our @ISA, 'Message::DOM::TreeCore::ManakaiDOMNode',
6137     'Message::DOM::IF::Attr',
6138     'Message::DOM::IF::Node',
6139     'Message::DOM::IFLatest::Attr',
6140     'Message::DOM::IFLatest::Node',
6141     'Message::DOM::IFLevel1::Attr',
6142     'Message::DOM::IFLevel1::Node',
6143     'Message::DOM::IFLevel2::Attr',
6144     'Message::DOM::IFLevel2::Node',
6145     'Message::DOM::IFLevel3::Attr',
6146     'Message::DOM::IFLevel3::Node';
6147     use Char::Class::XML 'InXMLNameChar10',
6148     'InXMLNameChar11',
6149     'InXMLNameStartChar11',
6150     'InXML_NameStartChar10';
6151     sub ___create_node_stem ($$$$) {
6152     my ($self, $bag, $obj, $opt) = @_;
6153     my $r = {};
6154    
6155     {
6156    
6157    
6158     $obj->{
6159     'child'
6160     } = [];
6161    
6162    
6163     {
6164    
6165     if
6166     (defined ${$opt->{'ns'}}) {
6167     if (ref ${$opt->{'ns'}} eq 'SCALAR') {
6168     $obj->{'ns'} = ${$opt->{'ns'}};
6169     } elsif (defined $Message::Util::ManakaiStringRef::Value{${$opt->{'ns'}}}) {
6170     $obj->{'ns'} = $Message::Util::ManakaiStringRef::Value{${$opt->{'ns'}}};
6171     } else {
6172     require Scalar::Util;
6173     $obj->{'ns'} = $Message::Util::ManakaiStringRef::Value{${$opt->{'ns'}}} = \(${$opt->{'ns'}});
6174     Scalar::Util::weaken ($Message::Util::ManakaiStringRef::Value{${$opt->{'ns'}}});
6175     }
6176     } else {
6177     CORE::delete $obj->{'ns'};
6178     }
6179    
6180    
6181 wakaba 1.3 }
6182 wakaba 1.9
6183 wakaba 1.1 ;
6184 wakaba 1.9
6185 wakaba 1.1
6186     {
6187    
6188 wakaba 1.9 if
6189     (defined ${$opt->{'pfx'}}) {
6190     if (ref ${$opt->{'pfx'}} eq 'SCALAR') {
6191     $obj->{'pfx'} = ${$opt->{'pfx'}};
6192     } elsif (defined $Message::Util::ManakaiStringRef::Value{${$opt->{'pfx'}}}) {
6193     $obj->{'pfx'} = $Message::Util::ManakaiStringRef::Value{${$opt->{'pfx'}}};
6194     } else {
6195     require Scalar::Util;
6196     $obj->{'pfx'} = $Message::Util::ManakaiStringRef::Value{${$opt->{'pfx'}}} = \(${$opt->{'pfx'}});
6197     Scalar::Util::weaken ($Message::Util::ManakaiStringRef::Value{${$opt->{'pfx'}}});
6198     }
6199     } else {
6200     CORE::delete $obj->{'pfx'};
6201     }
6202 wakaba 1.1
6203    
6204 wakaba 1.3 }
6205 wakaba 1.1
6206     ;
6207 wakaba 1.9
6208 wakaba 1.1
6209     {
6210    
6211 wakaba 1.9 if
6212     (defined ${$opt->{'ln'}}) {
6213     if (ref ${$opt->{'ln'}} eq 'SCALAR') {
6214     $obj->{'ln'} = ${$opt->{'ln'}};
6215     } elsif (defined $Message::Util::ManakaiStringRef::Value{${$opt->{'ln'}}}) {
6216     $obj->{'ln'} = $Message::Util::ManakaiStringRef::Value{${$opt->{'ln'}}};
6217     } else {
6218     require Scalar::Util;
6219     $obj->{'ln'} = $Message::Util::ManakaiStringRef::Value{${$opt->{'ln'}}} = \(${$opt->{'ln'}});
6220     Scalar::Util::weaken ($Message::Util::ManakaiStringRef::Value{${$opt->{'ln'}}});
6221     }
6222     } else {
6223     CORE::delete $obj->{'ln'};
6224     }
6225 wakaba 1.1
6226    
6227 wakaba 1.3 }
6228 wakaba 1.1
6229     ;
6230 wakaba 1.9 $obj->{
6231     'specified'
6232     } = $opt->{
6233     'specified'
6234     };
6235 wakaba 1.1
6236    
6237     {
6238    
6239    
6240 wakaba 1.9 $obj->{'od'} = $opt->{'od'}->{
6241     'id'
6242     };
6243     $bag->{${$opt->{'od'}->{
6244     'id'
6245     }}}
6246     ->{'do'}->{${$obj->{
6247 wakaba 1.1 'id'
6248     }}}
6249 wakaba 1.9 = $obj->{
6250     'id'
6251     };
6252 wakaba 1.1
6253    
6254 wakaba 1.3 }
6255 wakaba 1.1
6256     ;
6257 wakaba 1.9 $r = $obj;
6258 wakaba 1.1
6259    
6260 wakaba 1.3 }
6261 wakaba 1.1 $r}
6262     sub node_type ($;$) {
6263     if (@_ == 1) {my ($self) = @_;
6264     my $r;
6265 wakaba 1.6 $r = 2;
6266 wakaba 1.1 $r;
6267     } else {my ($self) = @_;
6268     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';
6269     }
6270     }
6271     sub prefix ($;$) {
6272     if (@_ == 1) {my ($self) = @_;
6273     my $r = '';
6274    
6275     {
6276    
6277     my
6278     $v;
6279    
6280    
6281     {
6282    
6283    
6284     $v = $self->{
6285     'b'
6286     }->{${$self->{
6287     'id'
6288     }}}
6289     ->{'pfx'};
6290    
6291    
6292 wakaba 1.3 }
6293 wakaba 1.1
6294     ;
6295     $r = defined $v ? $$v :
6296     undef
6297     ;
6298    
6299    
6300 wakaba 1.3 }
6301 wakaba 1.1 $r;
6302     } else {my ($self, $given) = @_;
6303    
6304     {
6305    
6306     my
6307     $od = $self->
6308     owner_document
6309     ;
6310     if ($od->
6311     strict_error_checking
6312     ) {
6313    
6314    
6315     {
6316    
6317     if
6318     ($self->
6319     manakai_read_only
6320     ) {
6321    
6322     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';
6323    
6324     ;
6325     }
6326    
6327    
6328 wakaba 1.3 }
6329 wakaba 1.1
6330     ;
6331     my $nsuri;
6332    
6333    
6334     {
6335    
6336    
6337     $nsuri = $self->{
6338     'b'
6339     }->{${$self->{
6340     'id'
6341     }}}
6342     ->{'ns'};
6343    
6344    
6345 wakaba 1.3 }
6346 wakaba 1.1
6347     ;
6348     if (not defined $nsuri) {
6349    
6350     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';
6351    
6352     ;
6353     } elsif ($$nsuri ne
6354     'http://www.w3.org/XML/1998/namespace' and
6355    
6356     defined $given and $given eq 'xml') {
6357    
6358     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';
6359    
6360     ;
6361     } elsif ($$nsuri ne
6362     'http://www.w3.org/2000/xmlns/' and
6363    
6364     defined $given and $given eq 'xmlns') {
6365    
6366     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';
6367    
6368     ;
6369     } elsif ($self->
6370     node_name eq
6371     'xmlns') {
6372    
6373     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';
6374    
6375     ;
6376     }
6377     my $version = $od->
6378     xml_version
6379     ;
6380    
6381    
6382     {
6383    
6384     if
6385     (defined $given and $given eq '') {
6386 wakaba 1.9 require Message::DOM::DOMMain;
6387 wakaba 1.1
6388     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';
6389    
6390     ;
6391     undef $given;
6392     }
6393     if (defined $given) {
6394     if (($version eq '1.0' and
6395     not
6396     ($given =~ /\A\p{InXML_NameStartChar10}\p{InXMLNameChar10}*\z/)
6397     ) or
6398     ($version eq '1.1' and
6399     not
6400     ($given =~ /\A\p{InXMLNameStartChar11}\p{InXMLNameChar11}*\z/)
6401     )) {
6402    
6403     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';
6404    
6405     ;
6406     } elsif (index ($given, ':') > -1) {
6407    
6408     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';
6409    
6410     ;
6411     }
6412     } # has prefix
6413    
6414    
6415 wakaba 1.3 }
6416 wakaba 1.1
6417     ;
6418     } # strict
6419     my $v = defined $given ? \$given :
6420     undef
6421     ;
6422    
6423    
6424     {
6425    
6426    
6427     $self->{
6428     'b'
6429     }->{${$self->{
6430     'id'
6431     }}}
6432     ->{'pfx'} = $v;
6433    
6434    
6435 wakaba 1.3 }
6436 wakaba 1.1
6437     ;
6438    
6439    
6440 wakaba 1.3 }
6441 wakaba 1.1 }
6442     }
6443     sub append_child ($$) {
6444     my ($self, $newChild) = @_;
6445     my $r;
6446    
6447     {
6448    
6449     my
6450     $self_od = $self->
6451     owner_document
6452     ;
6453     my $child_od = $newChild->
6454     owner_document
6455     ;
6456     my $child_nt = $newChild->
6457     node_type
6458     ;
6459    
6460    
6461     {
6462    
6463    
6464     {
6465    
6466     local $Error::Depth = $Error::Depth + 1;
6467    
6468     {
6469    
6470    
6471     my
6472     $strict = $self_od->
6473     strict_error_checking
6474     ;
6475    
6476     ## -- Node Type check
6477     my @new_child;
6478     if ({
6479 wakaba 1.6 3 => 1,
6480     5 => 1,
6481 wakaba 1.1 }->{$child_nt}) {
6482     push @new_child, $newChild;
6483     } elsif ($child_nt ==
6484 wakaba 1.6 11
6485 wakaba 1.1 ) {
6486     for my $cn (@{$newChild->
6487     child_nodes
6488     }) {
6489     unless ({
6490 wakaba 1.6 3 => 1,
6491     5 => 1,
6492 wakaba 1.1 }->{$cn->
6493     node_type
6494     }) {
6495    
6496    
6497     {
6498    
6499     local $Error::Depth = $Error::Depth - 1;
6500    
6501     {
6502    
6503     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;
6504    
6505    
6506 wakaba 1.3 }
6507 wakaba 1.1
6508    
6509     ;}
6510    
6511     ;
6512     }
6513     push @new_child, $cn;
6514     }
6515     } else {
6516    
6517    
6518     {
6519    
6520     local $Error::Depth = $Error::Depth - 1;
6521    
6522     {
6523    
6524     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;
6525    
6526    
6527 wakaba 1.3 }
6528 wakaba 1.1
6529    
6530     ;}
6531    
6532     ;
6533     }
6534    
6535     my $nc_parent = @new_child ? $new_child[0]->
6536     parent_node
6537     :
6538    
6539     undef
6540     ;
6541     if ($strict) {
6542     ## -- Wrong-document check
6543     unless ($self_od eq $child_od) {
6544    
6545    
6546     {
6547    
6548     local $Error::Depth = $Error::Depth - 1;
6549    
6550     {
6551    
6552     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;
6553    
6554    
6555 wakaba 1.3 }
6556 wakaba 1.1
6557    
6558     ;}
6559    
6560     ;
6561     }
6562    
6563     ## -- Read-onlyness check
6564     if ($self->
6565     manakai_read_only
6566     ) {
6567    
6568    
6569     {
6570    
6571     local $Error::Depth = $Error::Depth - 1;
6572    
6573     {
6574    
6575     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';
6576    
6577    
6578 wakaba 1.3 }
6579 wakaba 1.1
6580    
6581     ;}
6582    
6583     ;
6584     }
6585     if (@new_child) {
6586     if ($nc_parent and
6587     $nc_parent->
6588     manakai_read_only
6589     ) {
6590    
6591    
6592     {
6593    
6594     local $Error::Depth = $Error::Depth - 1;
6595    
6596     {
6597    
6598     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';
6599    
6600    
6601 wakaba 1.3 }
6602 wakaba 1.1
6603    
6604     ;}
6605    
6606     ;
6607     }
6608     }
6609     }
6610    
6611     ## -- Insert at...
6612     my $index = -1; # last
6613    
6614    
6615     ; # FOR !tc:ForAppendChild
6616    
6617     ## -- Removes from parent
6618     if ($nc_parent) {
6619     if ($child_nt ==
6620 wakaba 1.6 11
6621 wakaba 1.1 ) {
6622    
6623    
6624     {
6625    
6626    
6627     $newChild->{
6628     'b'
6629     }->{${$newChild->{
6630     'id'
6631     }}}
6632     ->{'child'} = [];
6633    
6634    
6635 wakaba 1.3 }
6636 wakaba 1.1
6637     ;
6638     } else {
6639     my $v;
6640    
6641    
6642     {
6643    
6644    
6645     $v = $nc_parent->{
6646     'b'
6647     }->{${$nc_parent->{
6648     'id'
6649     }}}
6650     ->{'child'};
6651    
6652    
6653 wakaba 1.3 }
6654 wakaba 1.1
6655     ;
6656     RP: for my $i (0..$#$v) {
6657     my $nodeid = $v->[$i];
6658     if (
6659     (${$new_child[0]->{'id'}} eq ${$nodeid})
6660     ) {
6661     splice @$v, $i, 1, ();
6662     last RP;
6663     }
6664     } # RP
6665     }
6666     }
6667    
6668     ## -- Rewrite the |parentNode| properties
6669     for my $nc (@new_child) {
6670    
6671    
6672     {
6673    
6674    
6675     $nc->{
6676     'b'
6677     }->{${$nc->{
6678     'id'
6679     }}}
6680     ->{'parent'} = $self->{
6681     'id'
6682     };
6683    
6684    
6685 wakaba 1.3 }
6686 wakaba 1.1
6687     ;
6688     }
6689    
6690     my $children;
6691    
6692    
6693     {
6694    
6695    
6696     $children = $self->{
6697     'b'
6698     }->{${$self->{
6699     'id'
6700     }}}
6701     ->{'child'};
6702    
6703    
6704 wakaba 1.3 }
6705 wakaba 1.1
6706     ;
6707    
6708    
6709    
6710     {
6711    
6712    
6713     ## -- Adds to children list
6714     push @$children, map {
6715    
6716     $_->{'id'}
6717    
6718     } @new_child;
6719     $r = $newChild;
6720    
6721    
6722    
6723 wakaba 1.3 }
6724 wakaba 1.1
6725     ;
6726    
6727    
6728    
6729     ;
6730    
6731    
6732    
6733     ;
6734    
6735    
6736    
6737 wakaba 1.3 }
6738 wakaba 1.1
6739    
6740     ;}
6741    
6742     ;
6743    
6744    
6745 wakaba 1.3 }
6746 wakaba 1.1
6747     ;
6748    
6749    
6750 wakaba 1.3 }
6751 wakaba 1.1 $r}
6752     sub insert_before ($$;$) {
6753     my ($self, $newChild, $refChild) = @_;
6754     my $r;
6755    
6756     {
6757    
6758     my
6759     $self_od = $self->
6760     owner_document
6761     ;
6762     my $child_od = $newChild->
6763     owner_document
6764     ;
6765     my $child_nt = $newChild->
6766     node_type
6767     ;
6768    
6769    
6770     {
6771    
6772    
6773     {
6774    
6775     local $Error::Depth = $Error::Depth + 1;
6776    
6777     {
6778    
6779    
6780     my
6781     $strict = $self_od->
6782     strict_error_checking
6783     ;
6784    
6785     ## -- Node Type check
6786     my @new_child;
6787     if ({
6788 wakaba 1.6 3 => 1,
6789     5 => 1,
6790 wakaba 1.1 }->{$child_nt}) {
6791     push @new_child, $newChild;
6792     } elsif ($child_nt ==
6793 wakaba 1.6 11
6794 wakaba 1.1 ) {
6795     for my $cn (@{$newChild->
6796     child_nodes
6797     }) {
6798     unless ({
6799 wakaba 1.6 3 => 1,
6800     5 => 1,
6801 wakaba 1.1 }->{$cn->
6802     node_type
6803     }) {
6804    
6805    
6806     {
6807    
6808     local $Error::Depth = $Error::Depth - 1;
6809    
6810     {
6811    
6812     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;
6813    
6814    
6815 wakaba 1.3 }
6816 wakaba 1.1
6817    
6818     ;}
6819    
6820     ;
6821     }
6822     push @new_child, $cn;
6823     }
6824     } else {
6825    
6826    
6827     {
6828    
6829     local $Error::Depth = $Error::Depth - 1;
6830    
6831     {
6832    
6833     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;
6834    
6835    
6836 wakaba 1.3 }
6837 wakaba 1.1
6838    
6839     ;}
6840    
6841     ;
6842     }
6843    
6844     my $nc_parent = @new_child ? $new_child[0]->
6845     parent_node
6846     :
6847    
6848     undef
6849     ;
6850     if ($strict) {
6851     ## -- Wrong-document check
6852     unless ($self_od eq $child_od) {
6853    
6854    
6855     {
6856    
6857     local $Error::Depth = $Error::Depth - 1;
6858    
6859     {
6860    
6861     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;
6862    
6863    
6864 wakaba 1.3 }
6865 wakaba 1.1
6866    
6867     ;}
6868    
6869     ;
6870     }
6871    
6872     ## -- Read-onlyness check
6873     if ($self->
6874     manakai_read_only
6875     ) {
6876    
6877    
6878     {
6879    
6880     local $Error::Depth = $Error::Depth - 1;
6881    
6882     {
6883    
6884     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';
6885    
6886    
6887 wakaba 1.3 }
6888 wakaba 1.1
6889    
6890     ;}
6891    
6892     ;
6893     }
6894     if (@new_child) {
6895     if ($nc_parent and
6896     $nc_parent->
6897     manakai_read_only
6898     ) {
6899    
6900    
6901     {
6902    
6903     local $Error::Depth = $Error::Depth - 1;
6904    
6905     {
6906    
6907     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';
6908    
6909    
6910 wakaba 1.3 }
6911 wakaba 1.1
6912    
6913     ;}
6914    
6915     ;
6916     }
6917     }
6918     }
6919    
6920     ## -- Insert at...
6921     my $index = -1; # last
6922    
6923    
6924     {
6925    
6926    
6927     # tc:ForAppendChild & tc:ForReplaceChild
6928     if (defined $refChild) {
6929     if ($refChild eq $newChild) {
6930    
6931    
6932     {
6933    
6934    
6935     {
6936    
6937     local $Error::Depth = $Error::Depth - 1;
6938    
6939     {
6940    
6941     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';
6942    
6943    
6944 wakaba 1.3 }
6945 wakaba 1.1
6946    
6947     ;}
6948    
6949     ;
6950    
6951    
6952    
6953 wakaba 1.3 }
6954 wakaba 1.1
6955     ;
6956    
6957    
6958     ;
6959     }
6960    
6961     my $cns = $self->
6962     child_nodes
6963     ;
6964     my $cnsl = @$cns;
6965     C: {
6966     $index = 0;
6967     for my $i (0..($cnsl-1)) {
6968     my $cn = $cns->[$i];
6969     if ($cn eq $refChild) {
6970     $index += $i;
6971     last C;
6972     } elsif ($cn eq $newChild) {
6973     $index = -1; # offset
6974     }
6975     }
6976    
6977    
6978     {
6979    
6980    
6981     {
6982    
6983     local $Error::Depth = $Error::Depth - 1;
6984    
6985     {
6986    
6987     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;
6988    
6989    
6990 wakaba 1.3 }
6991 wakaba 1.1
6992    
6993     ;}
6994    
6995     ;
6996    
6997    
6998    
6999 wakaba 1.3 }
7000 wakaba 1.1
7001     ;
7002    
7003    
7004     ;
7005     } # C
7006     } else { # |oldChild| is not defined
7007    
7008    
7009     ;
7010     }
7011    
7012    
7013    
7014 wakaba 1.3 }
7015 wakaba 1.1
7016     ; # FOR !tc:ForAppendChild
7017    
7018     ## -- Removes from parent
7019     if ($nc_parent) {
7020     if ($child_nt ==
7021 wakaba 1.6 11
7022 wakaba 1.1 ) {
7023    
7024    
7025     {
7026    
7027    
7028     $newChild->{
7029     'b'
7030     }->{${$newChild->{
7031     'id'
7032     }}}
7033     ->{'child'} = [];
7034    
7035    
7036 wakaba 1.3 }
7037 wakaba 1.1
7038     ;
7039     } else {
7040     my $v;
7041    
7042    
7043     {
7044    
7045    
7046     $v = $nc_parent->{
7047     'b'
7048     }->{${$nc_parent->{
7049     'id'
7050     }}}
7051     ->{'child'};
7052    
7053    
7054 wakaba 1.3 }
7055 wakaba 1.1
7056     ;
7057     RP: for my $i (0..$#$v) {
7058     my $nodeid = $v->[$i];
7059     if (
7060     (${$new_child[0]->{'id'}} eq ${$nodeid})
7061     ) {
7062     splice @$v, $i, 1, ();
7063     last RP;
7064     }
7065     } # RP
7066     }
7067     }
7068    
7069     ## -- Rewrite the |parentNode| properties
7070     for my $nc (@new_child) {
7071    
7072    
7073     {
7074    
7075    
7076     $nc->{
7077     'b'
7078     }->{${$nc->{
7079     'id'
7080     }}}
7081     ->{'parent'} = $self->{
7082     'id'
7083     };
7084    
7085    
7086 wakaba 1.3 }
7087 wakaba 1.1
7088     ;
7089     }
7090    
7091     my $children;
7092    
7093    
7094     {
7095    
7096    
7097     $children = $self->{
7098     'b'
7099     }->{${$self->{
7100     'id'
7101     }}}
7102     ->{'child'};
7103    
7104    
7105 wakaba 1.3 }
7106 wakaba 1.1
7107     ;
7108    
7109    
7110    
7111     ;
7112    
7113    
7114    
7115     {
7116    
7117    
7118     ## -- Adds to children list
7119     if ($index == -1) {
7120     push @$children, map {
7121    
7122     $_->{'id'}
7123    
7124     } @new_child;
7125     } else {
7126     splice @$children, $index, 0, map {
7127    
7128     $_->{'id'}
7129    
7130     } @new_child;
7131     }
7132     $r = $newChild;
7133    
7134    
7135    
7136 wakaba 1.3 }
7137 wakaba 1.1
7138     ;
7139    
7140    
7141    
7142     ;
7143    
7144    
7145    
7146 wakaba 1.3 }
7147 wakaba 1.1
7148    
7149     ;}
7150    
7151     ;
7152    
7153    
7154 wakaba 1.3 }
7155 wakaba 1.1
7156     ;
7157    
7158    
7159 wakaba 1.3 }
7160 wakaba 1.1 $r}
7161     sub replace_child ($$$) {
7162     my ($self, $newChild, $oldChild) = @_;
7163     my $r;
7164    
7165     {
7166    
7167     my
7168     $self_od = $self->
7169     owner_document
7170     ;
7171     my $child_od = $newChild->
7172     owner_document
7173     ;
7174     my $child_nt = $newChild->
7175     node_type
7176     ;
7177    
7178    
7179     {
7180    
7181    
7182     {
7183    
7184     local $Error::Depth = $Error::Depth + 1;
7185    
7186     {
7187    
7188    
7189     my
7190     $strict = $self_od->
7191     strict_error_checking
7192     ;
7193    
7194     ## -- Node Type check
7195     my @new_child;
7196     if ({
7197 wakaba 1.6 3 => 1,
7198     5 => 1,
7199 wakaba 1.1 }->{$child_nt}) {
7200     push @new_child, $newChild;
7201     } elsif ($child_nt ==
7202 wakaba 1.6 11
7203 wakaba 1.1 ) {
7204     for my $cn (@{$newChild->
7205     child_nodes
7206     }) {
7207     unless ({
7208 wakaba 1.6 3 => 1,
7209     5 => 1,
7210 wakaba 1.1 }->{$cn->
7211     node_type
7212     }) {
7213    
7214    
7215     {
7216    
7217     local $Error::Depth = $Error::Depth - 1;
7218    
7219     {
7220    
7221     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;
7222    
7223    
7224 wakaba 1.3 }
7225 wakaba 1.1
7226    
7227     ;}
7228    
7229     ;
7230     }
7231     push @new_child, $cn;
7232     }
7233     } else {
7234    
7235    
7236     {
7237    
7238     local $Error::Depth = $Error::Depth - 1;
7239    
7240     {
7241    
7242     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;
7243    
7244    
7245 wakaba 1.3 }
7246 wakaba 1.1
7247    
7248     ;}
7249    
7250     ;
7251     }
7252    
7253     my $nc_parent = @new_child ? $new_child[0]->
7254     parent_node
7255     :
7256    
7257     undef
7258     ;
7259     if ($strict) {
7260     ## -- Wrong-document check
7261     unless ($self_od eq $child_od) {
7262    
7263    
7264     {
7265    
7266     local $Error::Depth = $Error::Depth - 1;
7267    
7268     {
7269    
7270     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;
7271    
7272    
7273 wakaba 1.3 }
7274 wakaba 1.1
7275    
7276     ;}
7277    
7278     ;
7279     }
7280    
7281     ## -- Read-onlyness check
7282     if ($self->
7283     manakai_read_only
7284     ) {
7285    
7286    
7287     {
7288    
7289     local $Error::Depth = $Error::Depth - 1;
7290    
7291     {
7292    
7293     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';
7294    
7295    
7296 wakaba 1.3 }
7297 wakaba 1.1
7298    
7299     ;}
7300    
7301     ;
7302     }
7303     if (@new_child) {
7304     if ($nc_parent and
7305     $nc_parent->
7306     manakai_read_only
7307     ) {
7308    
7309    
7310     {
7311    
7312     local $Error::Depth = $Error::Depth - 1;
7313    
7314     {
7315    
7316     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';
7317    
7318    
7319 wakaba 1.3 }
7320 wakaba 1.1
7321    
7322     ;}
7323    
7324     ;
7325     }
7326     }
7327     }
7328    
7329     ## -- Insert at...
7330     my $index = -1; # last
7331    
7332    
7333     {
7334    
7335    
7336     # tc:ForAppendChild & tc:ForReplaceChild
7337     if (defined $oldChild) {
7338     if ($oldChild eq $newChild) {
7339    
7340    
7341     ;
7342    
7343    
7344     {
7345    
7346    
7347     {
7348    
7349     local $Error::Depth = $Error::Depth - 1;
7350    
7351     {
7352    
7353     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';
7354    
7355    
7356 wakaba 1.3 }
7357 wakaba 1.1
7358    
7359     ;}
7360    
7361     ;
7362    
7363    
7364    
7365 wakaba 1.3 }
7366 wakaba 1.1
7367     ;
7368     }
7369    
7370     my $cns = $self->
7371     child_nodes
7372     ;
7373     my $cnsl = @$cns;
7374     C: {
7375     $index = 0;
7376     for my $i (0..($cnsl-1)) {
7377     my $cn = $cns->[$i];
7378     if ($cn eq $oldChild) {
7379     $index += $i;
7380     last C;
7381     } elsif ($cn eq $newChild) {
7382     $index = -1; # offset
7383     }
7384     }
7385    
7386    
7387     ;
7388    
7389    
7390     {
7391    
7392    
7393     {
7394    
7395     local $Error::Depth = $Error::Depth - 1;
7396    
7397     {
7398    
7399     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;
7400    
7401    
7402 wakaba 1.3 }
7403 wakaba 1.1
7404    
7405     ;}
7406    
7407     ;
7408    
7409    
7410    
7411 wakaba 1.3 }
7412 wakaba 1.1
7413     ;
7414     } # C
7415     } else { # |oldChild| is not defined
7416    
7417    
7418     {
7419    
7420    
7421     {
7422    
7423     local $Error::Depth = $Error::Depth - 1;
7424    
7425     {
7426    
7427     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;
7428    
7429    
7430 wakaba 1.3 }
7431 wakaba 1.1
7432    
7433     ;}
7434    
7435     ;
7436    
7437    
7438    
7439 wakaba 1.3 }
7440 wakaba 1.1
7441     ;
7442     }
7443    
7444    
7445    
7446 wakaba 1.3 }
7447 wakaba 1.1
7448     ; # FOR !tc:ForAppendChild
7449    
7450     ## -- Removes from parent
7451     if ($nc_parent) {
7452     if ($child_nt ==
7453 wakaba 1.6 11
7454 wakaba 1.1 ) {
7455    
7456    
7457     {
7458    
7459    
7460     $newChild->{
7461     'b'
7462     }->{${$newChild->{
7463     'id'
7464     }}}
7465     ->{'child'} = [];
7466    
7467    
7468 wakaba 1.3 }
7469 wakaba 1.1
7470     ;
7471     } else {
7472     my $v;
7473    
7474    
7475     {
7476    
7477    
7478     $v = $nc_parent->{
7479     'b'
7480     }->{${$nc_parent->{
7481     'id'
7482     }}}
7483     ->{'child'};
7484    
7485    
7486 wakaba 1.3 }
7487 wakaba 1.1
7488     ;
7489     RP: for my $i (0..$#$v) {
7490     my $nodeid = $v->[$i];
7491     if (
7492     (${$new_child[0]->{'id'}} eq ${$nodeid})
7493     ) {
7494     splice @$v, $i, 1, ();
7495     last RP;
7496     }
7497     } # RP
7498     }
7499     }
7500    
7501     ## -- Rewrite the |parentNode| properties
7502     for my $nc (@new_child) {
7503    
7504    
7505     {
7506    
7507    
7508     $nc->{
7509     'b'
7510     }->{${$nc->{
7511     'id'
7512     }}}
7513     ->{'parent'} = $self->{
7514     'id'
7515     };
7516    
7517    
7518 wakaba 1.3 }
7519 wakaba 1.1
7520     ;
7521     }
7522    
7523     my $children;
7524    
7525    
7526     {
7527    
7528    
7529     $children = $self->{
7530     'b'
7531     }->{${$self->{
7532     'id'
7533     }}}
7534     ->{'child'};
7535    
7536    
7537 wakaba 1.3 }
7538 wakaba 1.1
7539     ;
7540    
7541    
7542    
7543     ;
7544    
7545    
7546    
7547     ;
7548    
7549    
7550    
7551     {
7552    
7553    
7554     ## -- Replaces the node
7555     splice @$children, $index, 1, map {
7556    
7557     $_->{'id'}
7558    
7559     } @new_child;
7560    
7561    
7562     {
7563    
7564     CORE::delete
7565     $oldChild->{
7566     'b'
7567     }->{${$oldChild->{
7568     'id'
7569     }}}
7570     ->{'parent'};
7571    
7572    
7573 wakaba 1.3 }
7574 wakaba 1.1
7575     ;
7576     $r = $oldChild;
7577    
7578    
7579    
7580 wakaba 1.3 }
7581 wakaba 1.1
7582     ;
7583    
7584    
7585    
7586 wakaba 1.3 }
7587 wakaba 1.1
7588    
7589     ;}
7590    
7591     ;
7592    
7593    
7594 wakaba 1.3 }
7595 wakaba 1.1
7596     ;
7597    
7598    
7599 wakaba 1.3 }
7600 wakaba 1.1 $r}
7601     sub node_name ($;$) {
7602     if (@_ == 1) {my ($self) = @_;
7603     my $r = '';
7604    
7605     {
7606    
7607     my
7608     $prefix;
7609    
7610    
7611     {
7612    
7613    
7614     $prefix = $self->{
7615     'b'
7616     }->{${$self->{
7617     'id'
7618     }}}
7619     ->{'pfx'};
7620    
7621    
7622 wakaba 1.3 }
7623 wakaba 1.1
7624     ;
7625     my $lname;
7626    
7627    
7628     {
7629    
7630    
7631     $lname = $self->{
7632     'b'
7633     }->{${$self->{
7634     'id'
7635     }}}
7636     ->{'ln'};
7637    
7638    
7639 wakaba 1.3 }
7640 wakaba 1.1
7641     ;
7642     $r = defined $prefix ? $$prefix.':'.$$lname : $$lname;
7643    
7644    
7645 wakaba 1.3 }
7646 wakaba 1.1 $r;
7647     } else {my ($self) = @_;
7648     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';
7649     }
7650     }
7651     sub name ($;$) {
7652     if (@_ == 1) {my ($self) = @_;
7653     my $r = '';
7654    
7655     {
7656    
7657     my
7658     $prefix;
7659    
7660    
7661     {
7662    
7663    
7664     $prefix = $self->{
7665     'b'
7666     }->{${$self->{
7667     'id'
7668     }}}
7669     ->{'pfx'};
7670    
7671    
7672 wakaba 1.3 }
7673 wakaba 1.1
7674     ;
7675     my $lname;
7676    
7677    
7678     {
7679    
7680    
7681     $lname = $self->{
7682     'b'
7683     }->{${$self->{
7684     'id'
7685     }}}
7686     ->{'ln'};
7687    
7688    
7689 wakaba 1.3 }
7690 wakaba 1.1
7691     ;
7692     $r = defined $prefix ? $$prefix.':'.$$lname : $$lname;
7693    
7694    
7695 wakaba 1.3 }
7696 wakaba 1.1 $r;
7697     } else {my ($self) = @_;
7698     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';
7699     }
7700     }
7701     sub node_value ($;$) {
7702     if (@_ == 1) {my ($self) = @_;
7703     my $r = '';
7704    
7705     {
7706    
7707    
7708     {
7709    
7710     local $Error::Depth = $Error::Depth + 1;
7711    
7712     {
7713    
7714    
7715 wakaba 1.11
7716     $r = '';
7717     for my $child (@{$self->
7718 wakaba 1.9 child_nodes
7719     }) {
7720     if ($child->
7721     node_type
7722     ==
7723    
7724     5
7725     ) {
7726     my $v = $child->
7727     text_content
7728     ;
7729     $v =~ s/[\x09\x0A\x0D]/ /;
7730     $r .= $v;
7731     } else {
7732     $r .= $child->
7733     text_content
7734     ;
7735     }
7736     } # childNodes
7737     my $vt;
7738    
7739    
7740     {
7741    
7742    
7743     $vt = $self->{
7744     'b'
7745     }->{${$self->{
7746     'id'
7747     }}}
7748     ->{'at'};
7749    
7750    
7751     }
7752 wakaba 1.1
7753     ;
7754 wakaba 1.9 unless (not defined $vt or
7755     $vt ==
7756     0 or
7757    
7758     $vt ==
7759     11 or
7760    
7761     $vt ==
7762     1
7763     ) {
7764     $r =~ s/\A\x20+//;
7765     $r =~ s/\x20+\z//;
7766     $r =~ s/\x20+/ /g;
7767     }
7768    
7769     if (defined $vt and $vt ==
7770     2 and
7771    
7772     $self->
7773     owner_document
7774     ->
7775     dom_config
7776    
7777     ->
7778     get_parameter
7779     (
7780     'http://suika.fam.cx/www/2006/dom-config/xml-id'
7781     )) {
7782     $r =~ s/[\x09\x0A\x0D\x20]+/ /g;
7783     $r =~ s/\A //;
7784     $r =~ s/ \z//;
7785     }
7786 wakaba 1.1
7787    
7788    
7789 wakaba 1.3 }
7790 wakaba 1.1
7791    
7792     ;}
7793    
7794     ;
7795    
7796    
7797 wakaba 1.3 }
7798 wakaba 1.1 $r;
7799     } else {my ($self, $given) = @_;
7800    
7801     {
7802    
7803    
7804     {
7805    
7806    
7807     {
7808    
7809 wakaba 1.9 if
7810     ($self->
7811     manakai_read_only
7812     ) {
7813    
7814     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';
7815    
7816     ;
7817     }
7818    
7819    
7820     }
7821    
7822     ;
7823    
7824     my @__old_children = @{$self->
7825     child_nodes
7826     };
7827     for my $__old_child (@__old_children) {
7828    
7829    
7830     {
7831    
7832     CORE::delete
7833     $__old_child->{
7834     'b'
7835     }->{${$__old_child->{
7836     'id'
7837     }}}
7838     ->{'parent'};
7839    
7840    
7841     }
7842 wakaba 1.1
7843 wakaba 1.9 ;
7844     }
7845 wakaba 1.1
7846 wakaba 1.9 my @__new_children;
7847     if (defined $given and length $given) {
7848     my $__text = $self->owner_document->
7849     create_text_node
7850 wakaba 1.1 ($given);
7851 wakaba 1.9 push @__new_children,
7852     $__text->{'id'}
7853     ;
7854    
7855    
7856     {
7857    
7858    
7859     $__text->{
7860     'b'
7861     }->{${$__text->{
7862     'id'
7863     }}}
7864     ->{'parent'} = $self->{
7865     'id'
7866     };
7867    
7868    
7869     }
7870 wakaba 1.1
7871 wakaba 1.9 ;
7872     }
7873    
7874    
7875    
7876     {
7877    
7878    
7879     $self->{
7880     'b'
7881     }->{${$self->{
7882     'id'
7883     }}}
7884     ->{'child'} = \@__new_children;
7885 wakaba 1.1
7886    
7887 wakaba 1.3 }
7888 wakaba 1.1
7889 wakaba 1.9 ;
7890    
7891 wakaba 1.1
7892 wakaba 1.9 }
7893 wakaba 1.1
7894     ;
7895    
7896    
7897 wakaba 1.3 }
7898 wakaba 1.1 }
7899     }
7900     sub manakai_append_text ($$) {
7901     my ($self, $string) = @_;
7902     my $r;
7903    
7904     {
7905    
7906    
7907     {
7908    
7909     local $Error::Depth = $Error::Depth + 1;
7910    
7911     {
7912    
7913    
7914     my
7915     $lc = $self->
7916     last_child
7917     ;
7918     if (defined $lc and
7919     $lc->
7920     node_type
7921     ==
7922 wakaba 1.6 3
7923 wakaba 1.1 ) {
7924     $lc->
7925     manakai_append_text
7926    
7927     (ref $string eq 'SCALAR' ? $string : \$string);
7928     } else {
7929     my $text = $self->
7930     owner_document
7931    
7932     ->
7933     create_text_node
7934    
7935     (ref $string eq 'SCALAR' ? $$string : $string);
7936     $self->
7937     append_child
7938     ($text);
7939     }
7940     $r = $self;
7941    
7942    
7943    
7944 wakaba 1.3 }
7945 wakaba 1.1
7946    
7947     ;}
7948    
7949     ;
7950    
7951    
7952 wakaba 1.3 }
7953 wakaba 1.1 $r}
7954     sub get_feature ($$$) {
7955     my ($self, $feature, $version) = @_;
7956    
7957     {
7958    
7959    
7960     $feature = lc $feature;
7961    
7962    
7963 wakaba 1.3 }
7964 wakaba 1.1
7965     {
7966    
7967    
7968     $version = '' unless defined $version;
7969    
7970    
7971 wakaba 1.3 }
7972 wakaba 1.1 my $r;
7973    
7974     {
7975    
7976    
7977     $feature =~ s/^\+//;
7978    
7979    
7980     {
7981    
7982     if
7983 wakaba 1.9 ($Message::Util::AutoLoad::Registry::Feature->{$feature}->{$version}) {
7984 wakaba 1.1 $r = $self;
7985     }
7986    
7987    
7988 wakaba 1.3 }
7989 wakaba 1.1
7990     ;
7991     unless (defined $r) {
7992    
7993    
7994     {
7995    
7996     local $Error::Depth = $Error::Depth + 1;
7997    
7998     {
7999    
8000    
8001    
8002     $r = $self->SUPER::get_feature ($feature, $version);
8003    
8004    
8005    
8006 wakaba 1.3 }
8007 wakaba 1.1
8008    
8009     ;}
8010    
8011     ;
8012     }
8013    
8014    
8015 wakaba 1.3 }
8016 wakaba 1.1 $r}
8017     sub base_uri ($;$) {
8018     if (@_ == 1) {my ($self) = @_;
8019     my $r = '';
8020    
8021     {
8022    
8023    
8024     {
8025    
8026     local $Error::Depth = $Error::Depth + 1;
8027    
8028     {
8029    
8030    
8031     my
8032     $oe = $self->
8033     owner_element
8034     ;
8035     if ($oe) {
8036 wakaba 1.9 my $ln = $self->local_name;
8037     my $nsuri = $self->namespace_uri;
8038     if (($ln eq 'base' and defined $nsuri and $nsuri eq
8039     'http://www.w3.org/XML/1998/namespace'
8040     ) or
8041     ($ln eq 'xml:base' and not defined $nsuri)) {
8042     my $oep = $oe->
8043     parent_node
8044     ;
8045     if ($oep) {
8046     $r = $oep->
8047     base_uri
8048     ;
8049     } else {
8050     $r = $self->
8051     owner_document
8052     ->
8053 wakaba 1.1 base_uri
8054     ;
8055 wakaba 1.9 }
8056     } else {
8057     $r = $oe->
8058     base_uri
8059     ;
8060     }
8061 wakaba 1.1 } else {
8062 wakaba 1.9 $r = $self->
8063 wakaba 1.1 owner_document
8064 wakaba 1.9 ->
8065 wakaba 1.1 base_uri
8066     ;
8067     }
8068    
8069    
8070    
8071 wakaba 1.3 }
8072 wakaba 1.1
8073    
8074     ;}
8075    
8076     ;
8077    
8078    
8079 wakaba 1.3 }
8080 wakaba 1.1 $r;
8081     } else {my ($self) = @_;
8082     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';
8083     }
8084     }
8085     sub owner_element ($;$) {
8086     if (@_ == 1) {my ($self) = @_;
8087     my $r;
8088    
8089     {
8090    
8091    
8092     {
8093    
8094     my
8095     $__v = $self->{
8096     'b'
8097     }->{${$self->{
8098     'id'
8099     }}}
8100     ->{'owner'};
8101     if (defined $__v) {
8102    
8103    
8104     {
8105    
8106    
8107     $r = ${$self->{'b'}->{${$__v}}->{
8108     'cls'
8109     }}->___create_node_ref ({
8110    
8111     'id'
8112     => $__v,
8113    
8114     'b'
8115     => $self->{'b'},
8116     }, {
8117     });
8118     $self->{'b'}->{${$__v}}->{
8119     'rc'
8120     }++;
8121    
8122    
8123 wakaba 1.3 }
8124 wakaba 1.1
8125     ;
8126     }
8127    
8128    
8129 wakaba 1.3 }
8130 wakaba 1.1
8131     ;
8132    
8133    
8134 wakaba 1.3 }
8135 wakaba 1.1 $r;
8136     } else {my ($self) = @_;
8137     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';
8138     }
8139     }
8140     sub specified ($;$) {
8141     if (@_ == 1) {my ($self) = @_;
8142     my $r = 0;
8143    
8144     {
8145    
8146    
8147     {
8148    
8149    
8150     $r = $self->{
8151     'b'
8152     }->{${$self->{
8153     'id'
8154     }}}
8155     ->{'specified'};
8156    
8157    
8158 wakaba 1.3 }
8159 wakaba 1.1
8160     ;
8161     unless ($r) {
8162     my $oe;
8163    
8164    
8165     {
8166    
8167    
8168     $oe = $self->{
8169     'b'
8170     }->{${$self->{
8171     'id'
8172     }}}
8173     ->{'owner'};
8174    
8175    
8176 wakaba 1.3 }
8177 wakaba 1.1
8178     ;
8179     unless (defined $oe) {
8180     $r =
8181     1
8182     ;
8183     }
8184     }
8185    
8186    
8187 wakaba 1.3 }
8188 wakaba 1.1 $r;
8189     } else {my ($self, $given) = @_;
8190    
8191     {
8192    
8193    
8194     {
8195    
8196     if
8197     ($self->
8198     manakai_read_only
8199     ) {
8200    
8201     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';
8202    
8203     ;
8204     }
8205    
8206    
8207 wakaba 1.3 }
8208 wakaba 1.1
8209     ;
8210     unless ($given) {
8211     my $oe;
8212    
8213    
8214     {
8215    
8216    
8217     $oe = $self->{
8218     'b'
8219     }->{${$self->{
8220     'id'
8221     }}}
8222     ->{'owner'};
8223    
8224    
8225 wakaba 1.3 }
8226 wakaba 1.1
8227     ;
8228     $given =
8229     1 unless
8230     defined $oe;
8231     }
8232    
8233    
8234     {
8235    
8236    
8237     $self->{
8238     'b'
8239     }->{${$self->{
8240     'id'
8241     }}}
8242     ->{'specified'} = $given;
8243    
8244    
8245 wakaba 1.3 }
8246 wakaba 1.1
8247     ;
8248    
8249    
8250 wakaba 1.3 }
8251 wakaba 1.1 }
8252     }
8253     sub value ($;$) {
8254     if (@_ == 1) {my ($self) = @_;
8255     my $r = '';
8256    
8257     {
8258    
8259    
8260     {
8261    
8262     local $Error::Depth = $Error::Depth + 1;
8263    
8264     {
8265    
8266    
8267 wakaba 1.11
8268     $r = '';
8269     for my $child (@{$self->
8270 wakaba 1.1 child_nodes
8271     }) {
8272     if ($child->
8273     node_type
8274     ==
8275    
8276 wakaba 1.6 5
8277 wakaba 1.1 ) {
8278     my $v = $child->
8279     text_content
8280     ;
8281     $v =~ s/[\x09\x0A\x0D]/ /;
8282     $r .= $v;
8283     } else {
8284     $r .= $child->
8285     text_content
8286     ;
8287     }
8288     } # childNodes
8289     my $vt;
8290    
8291    
8292     {
8293    
8294    
8295     $vt = $self->{
8296     'b'
8297     }->{${$self->{
8298     'id'
8299     }}}
8300     ->{'at'};
8301    
8302    
8303 wakaba 1.3 }
8304 wakaba 1.1
8305     ;
8306     unless (not defined $vt or
8307     $vt ==
8308 wakaba 1.6 0 or
8309 wakaba 1.1
8310     $vt ==
8311 wakaba 1.6 11 or
8312 wakaba 1.1
8313     $vt ==
8314 wakaba 1.6 1
8315 wakaba 1.1 ) {
8316     $r =~ s/\A\x20+//;
8317     $r =~ s/\x20+\z//;
8318     $r =~ s/\x20+/ /g;
8319     }
8320 wakaba 1.9
8321     if (defined $vt and $vt ==
8322     2 and
8323    
8324     $self->
8325     owner_document
8326     ->
8327     dom_config
8328    
8329     ->
8330     get_parameter
8331     (
8332     'http://suika.fam.cx/www/2006/dom-config/xml-id'
8333     )) {
8334     $r =~ s/[\x09\x0A\x0D\x20]+/ /g;
8335     $r =~ s/\A //;
8336     $r =~ s/ \z//;
8337     }
8338 wakaba 1.1
8339    
8340    
8341 wakaba 1.3 }
8342 wakaba 1.1
8343    
8344     ;}
8345    
8346     ;
8347    
8348    
8349 wakaba 1.3 }
8350 wakaba 1.1 $r;
8351     } else {my ($self, $given) = @_;
8352    
8353     {
8354    
8355    
8356     {
8357    
8358    
8359     {
8360    
8361     if
8362     ($self->
8363     manakai_read_only
8364     ) {
8365    
8366     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';
8367    
8368     ;
8369     }
8370    
8371    
8372 wakaba 1.3 }
8373 wakaba 1.1
8374     ;
8375    
8376     my @__old_children = @{$self->
8377     child_nodes
8378     };
8379     for my $__old_child (@__old_children) {
8380    
8381    
8382     {
8383    
8384     CORE::delete
8385     $__old_child->{
8386     'b'
8387     }->{${$__old_child->{
8388     'id'
8389     }}}
8390     ->{'parent'};
8391    
8392    
8393 wakaba 1.3 }
8394 wakaba 1.1
8395     ;
8396     }
8397    
8398     my @__new_children;
8399     if (defined $given and length $given) {
8400     my $__text = $self->owner_document->
8401     create_text_node
8402     ($given);
8403     push @__new_children,
8404     $__text->{'id'}
8405     ;
8406    
8407    
8408     {
8409    
8410    
8411     $__text->{
8412     'b'
8413     }->{${$__text->{
8414     'id'
8415     }}}
8416     ->{'parent'} = $self->{
8417     'id'
8418     };
8419    
8420    
8421 wakaba 1.3 }
8422 wakaba 1.1
8423     ;
8424     }
8425    
8426    
8427    
8428     {
8429    
8430    
8431     $self->{
8432     'b'
8433     }->{${$self->{
8434     'id'
8435     }}}
8436     ->{'child'} = \@__new_children;
8437    
8438    
8439 wakaba 1.3 }
8440 wakaba 1.1
8441     ;
8442    
8443    
8444 wakaba 1.3 }
8445 wakaba 1.1
8446     ;
8447    
8448    
8449 wakaba 1.3 }
8450 wakaba 1.1 }
8451     }
8452     sub schema_type_info ($;$) {
8453     if (@_ == 1) {my ($self) = @_;
8454     my $r;
8455    
8456     {
8457    
8458     my
8459     $type;
8460    
8461    
8462     {
8463    
8464    
8465     $type = $self->{
8466     'b'
8467     }->{${$self->{
8468     'id'
8469     }}}
8470     ->{'at'};
8471    
8472    
8473 wakaba 1.3 }
8474 wakaba 1.1
8475     ;
8476    
8477    
8478     {
8479    
8480     my
8481     $v = $type || 0;
8482     $r = bless \$v,
8483 wakaba 1.10 'Message::DOM::Element::ManakaiDOMDTDTypeInfo'
8484 wakaba 1.1 ;
8485    
8486    
8487 wakaba 1.3 }
8488 wakaba 1.1
8489     ;
8490    
8491    
8492 wakaba 1.3 }
8493 wakaba 1.1 $r;
8494     } else {my ($self) = @_;
8495     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';
8496     }
8497     }
8498     sub is_id ($;$) {
8499     if (@_ == 1) {my ($self) = @_;
8500     my $r = 0;
8501    
8502     {
8503    
8504     T:
8505     {
8506     ## DTD Attribute Type
8507     my $type;
8508    
8509    
8510     {
8511    
8512    
8513     $type = $self->{
8514     'b'
8515     }->{${$self->{
8516     'id'
8517     }}}
8518     ->{'at'};
8519    
8520    
8521 wakaba 1.3 }
8522 wakaba 1.1
8523     ;
8524     if (defined $type and $type ==
8525 wakaba 1.6 2
8526 wakaba 1.1 ) {
8527     $r =
8528     1
8529     ;
8530     last T;
8531     }
8532    
8533     ## User-determined ID
8534     my $udid;
8535    
8536    
8537     {
8538    
8539    
8540     $udid = $self->{
8541     'b'
8542     }->{${$self->{
8543     'id'
8544     }}}
8545     ->{'isudid'};
8546    
8547    
8548 wakaba 1.3 }
8549 wakaba 1.1
8550     ;
8551     if ($udid) {
8552     $r =
8553     1
8554     ;
8555     last T;
8556     }
8557    
8558     ## Application-determined ID
8559     my $nsuri = $self->
8560     namespace_uri
8561     ;
8562     my $ln = $self->
8563     local_name
8564     ;
8565     if (defined $nsuri and $nsuri eq
8566     'http://www.w3.org/XML/1998/namespace' and
8567    
8568     $ln eq 'id') {
8569     $r =
8570     1
8571     ;
8572     last T;
8573     } elsif (not defined $nsuri and $ln eq 'xml:id') {
8574     $r =
8575     1
8576     ;
8577     last T;
8578     }
8579     } # T
8580    
8581    
8582 wakaba 1.3 }
8583 wakaba 1.1 $r;
8584     } else {my ($self, $given) = @_;
8585    
8586     {
8587    
8588    
8589     {
8590    
8591     if
8592     ($self->
8593     manakai_read_only
8594     ) {
8595    
8596     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';
8597    
8598     ;
8599     }
8600    
8601    
8602 wakaba 1.3 }
8603 wakaba 1.1
8604     ;
8605    
8606    
8607     {
8608    
8609    
8610     $self->{
8611     'b'
8612     }->{${$self->{
8613     'id'
8614     }}}
8615     ->{'isudid'} = $given;
8616    
8617    
8618 wakaba 1.3 }
8619 wakaba 1.1
8620     ;
8621    
8622    
8623 wakaba 1.3 }
8624 wakaba 1.1 }
8625     }
8626     sub manakai_attribute_type ($;$) {
8627     if (@_ == 1) {my ($self) = @_;
8628     my $r = 0;
8629    
8630     {
8631    
8632    
8633     {
8634    
8635    
8636     $r = $self->{
8637     'b'
8638     }->{${$self->{
8639     'id'
8640     }}}
8641     ->{'at'};
8642    
8643    
8644 wakaba 1.3 }
8645 wakaba 1.1
8646     ;
8647     $r =
8648 wakaba 1.6 0 unless
8649 wakaba 1.1 defined $r;
8650    
8651    
8652 wakaba 1.3 }
8653 wakaba 1.1 $r;
8654     } else {my ($self, $given) = @_;
8655    
8656     {
8657    
8658    
8659     {
8660    
8661     if
8662     ($self->
8663     manakai_read_only
8664     ) {
8665    
8666     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';
8667    
8668     ;
8669     }
8670    
8671    
8672 wakaba 1.3 }
8673 wakaba 1.1
8674     ;
8675    
8676    
8677     {
8678    
8679    
8680     $self->{
8681     'b'
8682     }->{${$self->{
8683     'id'
8684     }}}
8685     ->{'at'} = $given;
8686    
8687    
8688 wakaba 1.3 }
8689 wakaba 1.1
8690     ;
8691    
8692    
8693 wakaba 1.3 }
8694 wakaba 1.1 }
8695     }
8696     $Message::DOM::DOMFeature::ClassInfo->{q<Message::DOM::Element::ManakaiDOMAttr>}->{has_feature} = {'core',
8697     {'',
8698     '1',
8699     '1.0',
8700     '1',
8701     '2.0',
8702     '1',
8703     '3.0',
8704     '1'},
8705     'xml',
8706     {'',
8707     '1',
8708     '1.0',
8709     '1',
8710     '2.0',
8711     '1',
8712     '3.0',
8713     '1'},
8714     'xmlversion',
8715     {'',
8716     '1',
8717     '1.0',
8718     '1',
8719     '1.1',
8720     '1'}};
8721     $Message::DOM::ClassPoint{q<Message::DOM::Element::ManakaiDOMAttr>} = 14.1;
8722     $Message::Util::Grove::ClassProp{q<Message::DOM::Element::ManakaiDOMAttr>} = {'o0',
8723     ['owner'],
8724     's1a',
8725     ['child'],
8726     'w0',
8727     ['od']};
8728 wakaba 1.10 package Message::DOM::IFLatest::TypeInfo;
8729 wakaba 1.12 our $VERSION = 20061203.0432;
8730 wakaba 1.10 sub DERIVATION_RESTRICTION () {
8731     1}
8732     sub DERIVATION_EXTENSION () {
8733     2}
8734     sub DERIVATION_UNION () {
8735     4}
8736     sub DERIVATION_LIST () {
8737     8}
8738     package Message::DOM::Element::ManakaiDOMDTDTypeInfo;
8739 wakaba 1.12 our $VERSION = 20061203.0432;
8740 wakaba 1.10 push our @ISA, 'Message::DOM::IF::TypeInfo',
8741     'Message::DOM::IFLatest::TypeInfo',
8742     'Message::DOM::IFLevel3::TypeInfo';
8743     sub type_name ($;$) {
8744     if (@_ == 1) {my ($self) = @_;
8745     my $r = '';
8746    
8747     {
8748    
8749    
8750     $r = {
8751    
8752     1
8753     => 'CDATA',
8754    
8755     2
8756     => 'ID',
8757    
8758     3
8759     => 'IDREF',
8760    
8761     4
8762     => 'IDREFS',
8763    
8764     5
8765     => 'ENTITY',
8766    
8767     6
8768     => 'ENTITIES',
8769    
8770     7
8771     => 'NMTOKEN',
8772    
8773     8
8774     => 'NMTOKENS',
8775    
8776     9
8777     => 'NOTATION',
8778    
8779     10
8780     => 'ENUMERATION',
8781     }->{$$self};
8782    
8783    
8784     }
8785     $r;
8786     } else {my ($self) = @_;
8787     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';
8788     }
8789     }
8790     sub type_namespace ($;$) {
8791     if (@_ == 1) {my ($self) = @_;
8792     my $r = '';
8793    
8794     {
8795    
8796    
8797     $r = {
8798    
8799     1
8800     =>
8801     1
8802     ,
8803    
8804     2
8805     =>
8806     1
8807     ,
8808    
8809     3
8810     =>
8811     1
8812     ,
8813    
8814     4
8815     =>
8816     1
8817     ,
8818    
8819     5
8820     =>
8821     1
8822     ,
8823    
8824     6
8825     =>
8826     1
8827     ,
8828    
8829     7
8830     =>
8831     1
8832     ,
8833    
8834     8
8835     =>
8836     1
8837     ,
8838    
8839     9
8840     =>
8841     1
8842     ,
8843    
8844     10
8845     =>
8846     1
8847     ,
8848     }->{$$self} ?
8849     'http://www.w3.org/TR/REC-xml' :
8850     undef;
8851    
8852    
8853     }
8854     $r;
8855     } else {my ($self) = @_;
8856     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';
8857     }
8858     }
8859     sub is_derived_from ($$$$) {
8860     my ($self, $typeNamespaceArg, $typeNameArg, $derivationMethod) = @_;
8861     my $r = 0;
8862    
8863    
8864     $r}
8865     use overload
8866     bool => sub () {1},
8867     'eq' => sub ($$) {
8868     my ($self, $t) = @_;
8869     my $r = 0;
8870    
8871     {
8872    
8873    
8874     {
8875    
8876     local $Error::Depth = $Error::Depth + 1;
8877    
8878     {
8879    
8880    
8881     if
8882     (UNIVERSAL::isa ($t,
8883     'Message::DOM::IFLatest::TypeInfo'
8884     )) {
8885     my $ln1 = $self->
8886     type_name
8887     ;
8888     my $ln2 = $t->
8889     type_name
8890     ;
8891     if ((defined $ln1 and defined $ln2 and $ln1 eq $ln2) or
8892     (not defined $ln1 or not defined $ln2)) {
8893     my $ns1 = $self->
8894     type_namespace
8895     ;
8896     my $ns2 = $t->
8897     type_namespace
8898     ;
8899     if ((defined $ns1 and defined $ns2 and $ns1 eq $ns2) or
8900     (not defined $ns1 and not defined $ns2)) {
8901     $r =
8902     1
8903     ;
8904     }
8905     }
8906     }
8907    
8908    
8909    
8910     }
8911    
8912    
8913     ;}
8914    
8915     ;
8916    
8917    
8918     }
8919     $r}
8920     ,
8921     fallback => 1;
8922     $Message::DOM::DOMFeature::ClassInfo->{q<Message::DOM::Element::ManakaiDOMDTDTypeInfo>}->{has_feature} = {'core',
8923     {'',
8924     '1',
8925     '3.0',
8926     '1'},
8927     'xml',
8928     {'',
8929     '1',
8930     '3.0',
8931     '1'},
8932     'xmlversion',
8933     {'',
8934     '1',
8935     '1.0',
8936     '1',
8937     '1.1',
8938     '1'}};
8939     $Message::DOM::ClassPoint{q<Message::DOM::Element::ManakaiDOMDTDTypeInfo>} = 8.1;
8940     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::){}
8941 wakaba 1.1 ## License: <http://suika.fam.cx/~wakaba/archive/2004/8/18/license#Perl+MPL>
8942     1;

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24