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

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

Parent Directory Parent Directory | Revision Log Revision Log

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