/[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.6 - (hide annotations) (download)
Sun Apr 16 08:20:27 2006 UTC (18 years, 7 months ago) by wakaba
Branch: MAIN
CVS Tags: manakai-release-0-3-1
Changes since 1.5: +33 -159 lines
++ manakai/t/ChangeLog	16 Apr 2006 08:00:28 -0000
2006-04-16  Wakaba  <wakaba@suika.fam.cx>

	* Makefile (dom-CharacterData.t): New test.

++ manakai/lib/Message/Util/ChangeLog	16 Apr 2006 08:02:29 -0000
2006-04-16  Wakaba  <wakaba@suika.fam.cx>

	* Makefile (.discore-all.pm): |CharacterData.pm| is added.

++ manakai/lib/Message/DOM/ChangeLog	16 Apr 2006 08:01:01 -0000
2006-04-16  Wakaba  <wakaba@suika.fam.cx>

	* CharacterData.dis: New module split from |TreeCore.dis|.

	* CharacterData.pm: Added to the CVS repository.

	* TreeCore.dis: The |CharacterData|, |Text|, and |Comment|
	interfaces are removed.
	(Require): A reference to the |MDOM:CharacterData| module
	is added.

	* DOMMain.dis (StringExtended, StringOutOfBoundsException): Removed.

	* DOMCore.dis (StringOutOfBoundsException): New error.

	* Makefile: |CharacterData.pm| is added.

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

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24