/[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.7 - (hide annotations) (download)
Sat Nov 4 12:25:13 2006 UTC (18 years ago) by wakaba
Branch: MAIN
Changes since 1.6: +48 -18 lines 
++ manakai/bin/ChangeLog	4 Nov 2006 11:58:05 -0000
2006-11-04  Wakaba  <wakaba@suika.fam.cx>

	* daf.pl: The |--debug| option no longer set
	obsoleted |$Message::DOM::DOMFeature::DEBUG| option.

++ manakai/lib/Message/Markup/ChangeLog	4 Nov 2006 12:14:20 -0000
2006-11-04  Wakaba  <wakaba@suika.fam.cx>

	* Atom.dis (AtomImplementation): It no
        longer inherits the |ManakaiDOMImplementation|; it
        is now expected to be implemented by |DOMImplementation|
        objects.
	(AtomDocument, AtomFeedDocument, AtomEntryDocument): It no
        longer inherits the |ManakaiDOMDocument|; it
        is now expected to be implemented by |Document|
        objects.

	* SuikaWikiConfig21.dis (SWCFGImplementation): It no
        longer inherits the |DOMImplementation|; it
        is now expected to be implemented by |DOMImplementation|
        objects.

++ manakai/lib/Message/Util/ChangeLog	4 Nov 2006 12:18:18 -0000
2006-11-04  Wakaba  <wakaba@suika.fam.cx>

	* DIS.dis (ManakaiDISImplementation): It no longer
	inherits |ManakaiDISImplementationValue|,
	|ManakaiDISImplementationPerl|, and |ManakaiSWCFGImplementation|
	interfaces.  The class is now expected to be implemented
	by |DOMImplementation| objects.

	* PerlCode.dis (addImplementedFeature, addImplementedElementType):
	New methods.
	(PCHasFeature, PCElementType): New interfaces.
	(PCDocument): It no longer inherits the |ManakaiDOMDocument|; it
        is now expected to be implemented by |Document|
        objects.
	(PCImplementation): It no longer inherits the |ManakaiDOMImplementation|;
	it is now expected to be implemented by |DOMImplementation|
	objects.

++ manakai/lib/Message/Util/DIS/ChangeLog	4 Nov 2006 12:24:32 -0000
2006-11-04  Wakaba  <wakaba@suika.fam.cx>

	* DNLite.dis (DISImplementationDNLite): It no
	longer inherits the |ManakaiDISImplementation|; it
        is now expected to be implemented by |DOMImplementation| objects.

	* DPG.dis (DPGDocument): It no longer inherits
	the |ManakaiDOMDocument| class; it is now expected to be
	implemented by all |Document| objects.

	* Perl.dis (DISImplementationPerl): It is now
	expected to be implemented by all |DOMImplementation| objects.
	(plCodeFragment): Support for the |p:require|
	property is added.  It no longer output |ClassInfo|
	for classes for specific element types; instead,
	it invoke |add_implemented_element_type| method.

	* Test.dis (DTImplementation): It no longer
	inherits the |MinimumImplementation| interface;
	instead, it is expected to be implemented
	by all |DOMImplementation| objects.

	* Value.dis (DISImplementationValue): It is now
	expected to be implemented by all |DOMImplementation| objects.

++ manakai/lib/Message/Util/AutoLoad/ChangeLog	4 Nov 2006 12:19:43 -0000
2006-11-04  Wakaba  <wakaba@suika.fam.cx>

	* Config.pm (register_all, save): Support for |feature|
	and |element_type| is added.

	* Registry-initial.pm: Updated.

	* .cvsignore: New file.


	* Registry-initial.pm: New module.
++ manakai/lib/Message/DOM/ChangeLog	4 Nov 2006 12:12:45 -0000
	explicitly inherits |urigen:ManakaiURIImplementation| (and
	the |f:ManakaiMinimumImplementation| class inherited
	by it).  The |f:Minimum| feature is ever implemented
	for compatibility (but is expected to be removed).
	Internal methods such as |___report_error| are copied from
	obsolete |f:MinimumImplementation| class.  DOM3
	methods |hasFeature| and |getFeature| are also
	moved from that class, but they now support no
	foreign classes.

	* DOMFeature.dis (ManakaiImplementationSource): It
	now |p:require|s |Message::Util::AutoLoad::Registry|.
	The class no longer support classes
	other than |ManakaiDOMImplementation|.  Note
	that the |ImplementationRegistry| object does continue
	to support foreign classes via foreign classes
	implementing |ImplementationSource|
	or |DOMImplementationSource| interface.
	(MinimumImplementation): Removed.

	* DOMLS.dis (ManakaiDOMImplementationLS): It no
	longer inherit the |ManakaiDOMImplementation|; it
	is now expected to be implemented by |DOMImplementation|
	objects.

	* DOMMain.dis (null): Removed.

	* Document.dis (___create_node_ref): It no
	longer support foreign classes other
	than |Message::DOM::Document::ManakaiDOMDocument|.
	Note that document format specific DOM
	interfaces, if supported, should be
	all instances of the |Document| interface
	in the implementation, as defined
	in the Web Applications 1.0 specification (where
	the |HTMLDocument| interface must be implemented
	by all |Document| objects, even if the |Document|
	contains no HTML element).

	* GenericLS.dis (GLSImplementation): It no
        longer inherit the |MinimumImplementation|; it
        is now expected to be implemented by |DOMImplementation|
        objects.
	(createGLSParser, createGLSSerializer): Load
	module implementing parser or serializer
	if necessary.

	* Traversal.dis (ManakaiDOMDocumentTraversal): It no
	longer inherits the |ManakaiDOMDocument|; it
	is now expected to be implemented by |Document|
	objects.

	* XDP.dis (XDPDocument): It no longer
	inherits the |Document|; it is now expected
	to be implemented by all |Document| objects.

	* XDoctype.dis (ManakaiDOMDocumentXDoctype): It no
        longer inherits the |ManakaiDOMDocument|; it
        is now expected to be implemented by |Document|
        objects.

2006-11-04  Wakaba  <wakaba@suika.fam.cx>

	* DOMCore.dis (ManakaiDOMImplementation): No longer
++ manakai/lib/Message/URI/ChangeLog	4 Nov 2006 12:14:59 -0000
2006-11-04  Wakaba  <wakaba@suika.fam.cx>

	* Generic.dis (URIImplementation): It no
	longer inherits the |MinimumImplementation|; it
	is now expected to be implemented by |DOMImplementation|
	objects.

++ manakai/lib/Message/Charset/ChangeLog	4 Nov 2006 11:56:24 -0000
2006-11-04  Wakaba  <wakaba@suika.fam.cx>

	* Encode.dis (MCEncodeImplementation): It no
	longer inherit the |MinimumImplementation|; it
	is now expected to be implemented by |DOMImplementation|
	objects.

++ manakai/lib/manakai/ChangeLog	4 Nov 2006 12:25:03 -0000
2006-11-04  Wakaba  <wakaba@suika.fam.cx>

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