/[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.7 - (show annotations) (download)
Sun Jun 18 04:12:48 2006 UTC (18 years, 5 months ago) by wakaba
Branch: MAIN
CVS Tags: manakai-release-0-3-2
Changes since 1.6: +160 -160 lines
++ manakai/lib/Message/DOM/ChangeLog	18 Jun 2006 04:12:29 -0000
2006-06-18  Wakaba  <wakaba@suika.fam.cx>

	* Traversal.dis (expandEntityReferences): Syntax was incorrect.

	* TreeCore.dis (manakaiReadOnly): Test assertion was incorrect.

	* XDP.dis (dtdText): Test assertion was incorrect.

1 #!/usr/bin/perl
2 ## This file is automatically generated
3 ## at 2006-06-18T02:07:45+00:00,
4 ## from file "../DOM/Document.dis",
5 ## 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 our $VERSION = 20060618.0207;
15 package Message::DOM::IFLatest::Document;
16 our $VERSION = 20060618.0207;
17 package Message::DOM::Document::ManakaiDOMDocument;
18 our $VERSION = 20060618.0207;
19 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 }
74
75 ;
76 $r = $obj;
77
78
79 }
80 $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 }
120
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 }
148
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 }
176
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 }
202
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 }
219
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 }
312
313 ;
314 }
315 } # CLS
316 $r = bless $obj, $$class;
317
318
319 }
320 $r}
321 sub node_type ($;$) {
322 if (@_ == 1) {my ($self) = @_;
323 my $r;
324 $r = 9;
325 $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 1
369 ) {
370 $has_el =
371 1
372 ;
373 } elsif ($child_nt ==
374 10
375 ) {
376 $has_dt =
377 1
378 ;
379 } elsif ($child_nt ==
380 11
381 ) {
382 for my $cn (@{$newChild->
383 child_nodes
384 }) {
385 my $cnt = $cn->
386 node_type
387 ;
388 if ($cnt ==
389 1
390 ) {
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 }
404
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 1
427 ) {
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 }
440
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 1
461 ) {
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 }
474
475
476 ;}
477
478 ;
479 } elsif ($ant ==
480 10
481 ) {
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 }
494
495
496 ;}
497
498 ;
499 }
500 $anode = $anode->
501 previous_sibling
502 ;
503 }
504 } # has_dt
505
506
507
508 }
509
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 3 => (not $strictc),
536 5 => (not $strictc),
537 1 => 1,
538 4 => (not $strictc),
539 7 => 1,
540 8 => 1,
541 10 => 1,
542 }->{$child_nt}) {
543 push @new_child, $newChild;
544 } elsif ($child_nt ==
545 11
546 ) {
547 for my $cn (@{$newChild->
548 child_nodes
549 }) {
550 unless ({
551 3 => (not $strictc),
552 5 => (not $strictc),
553 1 => 1,
554 4 => (not $strictc),
555 7 => 1,
556 8 => 1,
557 10 => 1,
558 }->{$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 }
573
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 }
594
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 }
622
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 }
645
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 }
668
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 11
687 ) {
688
689
690 {
691
692
693 $newChild->{
694 'b'
695 }->{${$newChild->{
696 'id'
697 }}}
698 ->{'child'} = [];
699
700
701 }
702
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 }
720
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 }
752
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 }
771
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 }
790
791 ;
792
793
794
795 ;
796
797
798
799 ;
800
801
802
803 }
804
805
806 ;}
807
808 ;
809
810
811 }
812
813 ;
814 if ($child_nt ==
815 10 and
816
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 $bag->{
834 'm'
835 }++;
836 CORE::delete $bag->{${$newChild->{
837 'id'
838 }}}
839 ->{'impl'};
840
841
842 }
843
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 }
868
869 ;
870 }
871
872
873 }
874 $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 1
914 ) {
915 $has_el =
916 1
917 ;
918 } elsif ($child_nt ==
919 10
920 ) {
921 $has_dt =
922 1
923 ;
924 } elsif ($child_nt ==
925 11
926 ) {
927 for my $cn (@{$newChild->
928 child_nodes
929 }) {
930 my $cnt = $cn->
931 node_type
932 ;
933 if ($cnt ==
934 1
935 ) {
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 }
949
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 1
975 ) {
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 }
988
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 1
1005 ) {
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 }
1018
1019
1020 ;}
1021
1022 ;
1023 } elsif ($ant ==
1024 10
1025 ) {
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 }
1038
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 1
1062 ) {
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 }
1075
1076
1077 ;}
1078
1079 ;
1080 } elsif ($ant ==
1081 10
1082 ) {
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 }
1095
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 10
1112 ) {
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 }
1125
1126
1127 ;}
1128
1129 ;
1130 }
1131 $anode = $anode->
1132 next_sibling
1133 ;
1134 }
1135 } # has_dt
1136
1137
1138
1139 }
1140
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 3 => (not $strictc),
1167 5 => (not $strictc),
1168 1 => 1,
1169 4 => (not $strictc),
1170 7 => 1,
1171 8 => 1,
1172 10 => 1,
1173 }->{$child_nt}) {
1174 push @new_child, $newChild;
1175 } elsif ($child_nt ==
1176 11
1177 ) {
1178 for my $cn (@{$newChild->
1179 child_nodes
1180 }) {
1181 unless ({
1182 3 => (not $strictc),
1183 5 => (not $strictc),
1184 1 => 1,
1185 4 => (not $strictc),
1186 7 => 1,
1187 8 => 1,
1188 10 => 1,
1189 }->{$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 }
1204
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 }
1225
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 }
1253
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 }
1276
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 }
1299
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 }
1333
1334
1335 ;}
1336
1337 ;
1338
1339
1340
1341 }
1342
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 }
1379
1380
1381 ;}
1382
1383 ;
1384
1385
1386
1387 }
1388
1389 ;
1390
1391
1392 ;
1393 } # C
1394 } else { # |oldChild| is not defined
1395
1396
1397 ;
1398 }
1399
1400
1401
1402 }
1403
1404 ; # FOR !tc:ForAppendChild
1405
1406 ## -- Removes from parent
1407 if ($nc_parent) {
1408 if ($child_nt ==
1409 11
1410 ) {
1411
1412
1413 {
1414
1415
1416 $newChild->{
1417 'b'
1418 }->{${$newChild->{
1419 'id'
1420 }}}
1421 ->{'child'} = [];
1422
1423
1424 }
1425
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 }
1443
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 }
1475
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 }
1494
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 }
1525
1526 ;
1527
1528
1529
1530 ;
1531
1532
1533
1534 }
1535
1536
1537 ;}
1538
1539 ;
1540
1541
1542 }
1543
1544 ;
1545 if ($child_nt ==
1546 10 and
1547
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 $bag->{
1565 'm'
1566 }++;
1567 CORE::delete $bag->{${$newChild->{
1568 'id'
1569 }}}
1570 ->{'impl'};
1571
1572
1573 }
1574
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 }
1599
1600 ;
1601 }
1602
1603
1604 }
1605 $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 1
1645 ) {
1646 $has_el =
1647 1
1648 ;
1649 } elsif ($child_nt ==
1650 10
1651 ) {
1652 $has_dt =
1653 1
1654 ;
1655 } elsif ($child_nt ==
1656 11
1657 ) {
1658 for my $cn (@{$newChild->
1659 child_nodes
1660 }) {
1661 my $cnt = $cn->
1662 node_type
1663 ;
1664 if ($cnt ==
1665 1
1666 ) {
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 }
1680
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 1
1703 ) {
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 }
1716
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 1
1735 ) {
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 }
1748
1749
1750 ;}
1751
1752 ;
1753 } elsif ($ant ==
1754 10
1755 ) {
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 }
1768
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 1
1789 ) {
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 }
1802
1803
1804 ;}
1805
1806 ;
1807 } elsif ($ant ==
1808 10
1809 ) {
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 }
1822
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 10
1841 ) {
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 }
1854
1855
1856 ;}
1857
1858 ;
1859 }
1860 $anode = $anode->
1861 next_sibling
1862 ;
1863 }
1864 } # has_dt
1865
1866
1867
1868 }
1869
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 3 => (not $strictc),
1896 5 => (not $strictc),
1897 1 => 1,
1898 4 => (not $strictc),
1899 7 => 1,
1900 8 => 1,
1901 10 => 1,
1902 }->{$child_nt}) {
1903 push @new_child, $newChild;
1904 } elsif ($child_nt ==
1905 11
1906 ) {
1907 for my $cn (@{$newChild->
1908 child_nodes
1909 }) {
1910 unless ({
1911 3 => (not $strictc),
1912 5 => (not $strictc),
1913 1 => 1,
1914 4 => (not $strictc),
1915 7 => 1,
1916 8 => 1,
1917 10 => 1,
1918 }->{$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 }
1933
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 }
1954
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 }
1982
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 }
2005
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 }
2028
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 }
2065
2066
2067 ;}
2068
2069 ;
2070
2071
2072
2073 }
2074
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 }
2111
2112
2113 ;}
2114
2115 ;
2116
2117
2118
2119 }
2120
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 }
2139
2140
2141 ;}
2142
2143 ;
2144
2145
2146
2147 }
2148
2149 ;
2150 }
2151
2152
2153
2154 }
2155
2156 ; # FOR !tc:ForAppendChild
2157
2158 ## -- Removes from parent
2159 if ($nc_parent) {
2160 if ($child_nt ==
2161 11
2162 ) {
2163
2164
2165 {
2166
2167
2168 $newChild->{
2169 'b'
2170 }->{${$newChild->{
2171 'id'
2172 }}}
2173 ->{'child'} = [];
2174
2175
2176 }
2177
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 }
2195
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 }
2227
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 }
2246
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 }
2282
2283 ;
2284 $r = $oldChild;
2285
2286
2287
2288 }
2289
2290 ;
2291
2292
2293
2294 }
2295
2296
2297 ;}
2298
2299 ;
2300
2301
2302 }
2303
2304 ;
2305 if ($child_nt ==
2306 10 and
2307
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 $bag->{
2325 'm'
2326 }++;
2327 CORE::delete $bag->{${$newChild->{
2328 'id'
2329 }}}
2330 ->{'impl'};
2331
2332
2333 }
2334
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 }
2359
2360 ;
2361 }
2362
2363
2364 }
2365 $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 3
2398 ) {
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 }
2418
2419
2420 ;}
2421
2422 ;
2423
2424
2425 }
2426 $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 }
2472
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 }
2489
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 }
2503
2504 ;
2505
2506
2507 }
2508 $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 3 or
2556
2557 $nt ==
2558 4
2559 ) {
2560 $r .= $node->
2561 data
2562 unless
2563 $node->
2564 is_element_content_whitespace
2565 ;
2566 } elsif ($nt ==
2567 1 or
2568
2569 $nt ==
2570 5
2571 ) {
2572 unshift @target, @{$node->
2573 child_nodes
2574 };
2575 }
2576 }
2577 }
2578
2579
2580
2581 }
2582
2583
2584 ;}
2585
2586 ;
2587
2588
2589 }
2590 $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 }
2629
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 }
2650
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 }
2678
2679 ;
2680 }
2681
2682
2683
2684 {
2685
2686
2687 $self->{
2688 'b'
2689 }->{${$self->{
2690 'id'
2691 }}}
2692 ->{'child'} = \@__new_children;
2693
2694
2695 }
2696
2697 ;
2698
2699
2700 }
2701
2702 ;
2703 }
2704
2705
2706 }
2707 }
2708 }
2709 sub get_feature ($$$) {
2710 my ($self, $feature, $version) = @_;
2711
2712 {
2713
2714
2715 $feature = lc $feature;
2716
2717
2718 }
2719
2720 {
2721
2722
2723 $version = '' unless defined $version;
2724
2725
2726 }
2727 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 }
2782
2783 ;
2784 last CLASS;
2785 }
2786 } # CLASS
2787 }
2788
2789
2790 }
2791
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 }
2809
2810
2811 ;}
2812
2813 ;
2814 }
2815
2816
2817 }
2818 $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 }
2838
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 }
2855
2856 ;
2857 }
2858
2859
2860 }
2861 $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 }
2908
2909 ;
2910
2911
2912 ;
2913 }
2914
2915
2916 }
2917
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 }
2949
2950
2951 ;}
2952
2953 ;
2954
2955
2956 }
2957 $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 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:1148810725:4054:uUDJ249673+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest';
2967
2968 ;
2969
2970
2971
2972 {
2973
2974
2975 $namespaceURI = undef;
2976
2977
2978
2979 }
2980
2981 ;
2982 }
2983
2984
2985 }
2986 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 }
3050
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 }
3107
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 }
3169
3170 ;
3171 $bag->{${$stem->{
3172 'id'
3173 }}} = $stem;
3174
3175
3176 }
3177
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 }
3203
3204 ;
3205
3206 ## Default attributes
3207
3208
3209 {
3210
3211
3212 {
3213
3214 local $Error::Depth = $Error::Depth + 1;
3215
3216 {
3217
3218
3219 XDA:
3220 {
3221 my $__cfg = $self->
3222 dom_config
3223 ;
3224 last XDA unless $__cfg->
3225 get_parameter
3226
3227 (
3228 'http://suika.fam.cx/www/2006/dom-config/dtd-default-attribute'
3229 );
3230 my $__doctype = $self->
3231 doctype
3232 ;
3233 last XDA unless defined $__doctype;
3234 $__doctype = $__doctype->
3235 get_feature
3236
3237 (
3238 'http://suika.fam.cx/www/2006/feature/XDoctype'
3239 => '3.0');
3240 last XDA unless defined $__doctype;
3241 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 4 or
3279
3280 $__at_default ==
3281 1
3282 ) {
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 } # XDA
3449
3450
3451
3452 }
3453
3454
3455 ;}
3456
3457 ;
3458
3459
3460 }
3461
3462 ;
3463
3464
3465 }
3466 $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 }
3509
3510 ;
3511
3512
3513 ;
3514 }
3515
3516
3517 }
3518
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 }
3550
3551
3552 ;}
3553
3554 ;
3555
3556
3557 }
3558 $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 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:1148810725:4054:uUDJ249673+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest';
3568
3569 ;
3570
3571
3572
3573 {
3574
3575
3576 $namespaceURI = undef;
3577
3578
3579
3580 }
3581
3582 ;
3583 }
3584
3585
3586 }
3587 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 }
3660
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 }
3717
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 }
3770
3771 ;
3772 $bag->{${$stem->{
3773 'id'
3774 }}} = $stem;
3775
3776
3777 }
3778
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 }
3804
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 2
3836 );
3837 }
3838
3839
3840
3841 }
3842
3843
3844 ;}
3845
3846 ;
3847 }
3848
3849
3850 }
3851 $r}
3852 sub create_text_node ($$) {
3853 my ($self, $data) = @_;
3854 my $r;
3855
3856 {
3857
3858 require
3859 Message::DOM::CharacterData;
3860 my $bag =
3861 $self->{'b'}
3862 ;
3863 my $stem;
3864
3865
3866 {
3867
3868
3869 $stem = 'Message::DOM::CharacterData::ManakaiDOMText'->___create_node_stem ($bag, {
3870
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 (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 } else {
3896 require Scalar::Util;
3897 $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 }
3900 } else {
3901 CORE::delete $stem->{'cls'};
3902 }
3903
3904
3905 }
3906
3907 ;
3908 $bag->{${$stem->{
3909 'id'
3910 }}} = $stem;
3911
3912
3913 }
3914
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 }
3940
3941 ;
3942
3943
3944 }
3945 $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 }
4000
4001 ;
4002 $bag->{${$stem->{
4003 'id'
4004 }}} = $stem;
4005
4006
4007 }
4008
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 }
4034
4035 ;
4036
4037
4038 }
4039 $r}
4040 sub create_comment ($$) {
4041 my ($self, $data) = @_;
4042 my $r;
4043
4044 {
4045
4046 require
4047 Message::DOM::CharacterData;
4048 my $bag =
4049 $self->{'b'}
4050 ;
4051 my $stem;
4052
4053
4054 {
4055
4056
4057 $stem = 'Message::DOM::CharacterData::ManakaiDOMComment'->___create_node_stem ($bag, {
4058
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 (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 } else {
4084 require Scalar::Util;
4085 $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 }
4088 } else {
4089 CORE::delete $stem->{'cls'};
4090 }
4091
4092
4093 }
4094
4095 ;
4096 $bag->{${$stem->{
4097 'id'
4098 }}} = $stem;
4099
4100
4101 }
4102
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 }
4128
4129 ;
4130
4131
4132 }
4133 $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 }
4186
4187 ;
4188 $bag->{${$stem->{
4189 'id'
4190 }}} = $stem;
4191
4192
4193 }
4194
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 }
4220
4221 ;
4222
4223
4224 }
4225 $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 }
4272
4273 ;
4274
4275
4276 ;
4277 }
4278
4279
4280 }
4281
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 }
4331
4332 ;
4333 $bag->{${$stem->{
4334 'id'
4335 }}} = $stem;
4336
4337
4338 }
4339
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 }
4365
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 }
4440
4441
4442 ;}
4443
4444 ;
4445
4446
4447 }
4448 $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 }
4492
4493 ;
4494
4495
4496 ;
4497 }
4498
4499
4500 }
4501
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 }
4553
4554 ;
4555 $bag->{${$stem->{
4556 'id'
4557 }}} = $stem;
4558
4559
4560 }
4561
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 }
4587
4588 ;
4589
4590
4591 }
4592 $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 }
4612
4613 ;
4614 $r =
4615 1 unless
4616 defined $r;
4617
4618
4619 }
4620 $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 }
4638
4639 ;
4640
4641
4642 }
4643 }
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 }
4662
4663 ;
4664
4665
4666 }
4667 $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 1
4694 ) {
4695 $r = $child;
4696 last F;
4697 }
4698 } # F
4699
4700
4701
4702 }
4703
4704
4705 ;}
4706
4707 ;
4708
4709
4710 }
4711 $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 }
4756
4757 ;
4758 }
4759
4760
4761 }
4762
4763 ;
4764
4765
4766 }
4767 $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 }
4791
4792 ;
4793 $r = '1.0' unless defined $r;
4794
4795
4796 }
4797 $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 }
4817
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 }
4838
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 }
4849 }
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 10
4874 ) {
4875 $r = $child;
4876 last F;
4877 } elsif ($nt ==
4878 1
4879 ) { # document element
4880 last F;
4881 }
4882 } # F
4883
4884
4885
4886 }
4887
4888
4889 ;}
4890
4891 ;
4892
4893
4894 }
4895 $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 }
4919
4920 ;
4921
4922
4923 }
4924 $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 }
4944
4945 ;
4946
4947
4948 {
4949
4950
4951 $self->{
4952 'b'
4953 }->{${$self->{
4954 'id'
4955 }}}
4956 ->{'duri'} = $given;
4957
4958
4959 }
4960
4961 ;
4962
4963
4964 }
4965 }
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 }
4986
4987 ;
4988
4989
4990 }
4991 $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 }
5011
5012 ;
5013
5014
5015 {
5016
5017
5018 $self->{
5019 'b'
5020 }->{${$self->{
5021 'id'
5022 }}}
5023 ->{'ces'} = $given;
5024
5025
5026 }
5027
5028 ;
5029
5030
5031 }
5032 }
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 }
5053
5054 ;
5055
5056
5057 }
5058 $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 }
5078
5079 ;
5080
5081
5082 {
5083
5084
5085 $self->{
5086 'b'
5087 }->{${$self->{
5088 'id'
5089 }}}
5090 ->{'xcs'} = $given;
5091
5092
5093 }
5094
5095 ;
5096
5097
5098 }
5099 }
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 }
5120
5121 ;
5122
5123
5124 }
5125 $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 }
5145
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 }
5161
5162 ;
5163
5164
5165 }
5166 }
5167 }
5168 sub adopt_node ($$) {
5169 my ($self, $source) = @_;
5170 my $r;
5171
5172 {
5173
5174 ADOPT:
5175 {
5176 last ADOPT
5177 unless $source->isa (
5178 'Message::DOM::TreeCore::ManakaiDOMNode'
5179 ) and
5180
5181 $self->{'b'}
5182 eq
5183
5184 $source->{'b'}
5185 ;
5186
5187 my $strict = $self->
5188 strict_error_checking
5189 ;
5190 if ($strict and $self->
5191 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 if ($strict and defined $parent and
5202 $parent->
5203 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 2
5216 ) {
5217 $oe = $source->
5218 owner_element
5219 ;
5220 if ($strict and defined $oe and $oe->
5221 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 9 or
5230
5231 $nt ==
5232 10 or
5233
5234 $nt ==
5235 6 or
5236
5237 $nt ==
5238 12
5239 ) {
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 if ($strict and $node->
5254 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 1
5263 ) {
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 2 or
5281
5282 $nt ==
5283 5 or
5284
5285 $nt ==
5286 11
5287 ) {
5288 push @change_od, $node;
5289 push @nodes, @{$node->
5290 child_nodes
5291 };
5292 } elsif ($nt ==
5293 3 or
5294
5295 $nt ==
5296 8 or
5297
5298 $nt ==
5299 7 or
5300
5301 $nt ==
5302 4
5303 ) {
5304 push @change_od, $node;
5305 } else {
5306 ## TODO: assertion
5307 }
5308 } # nodes
5309
5310
5311
5312 {
5313
5314 local $Error::Depth = $Error::Depth + 1;
5315
5316 {
5317
5318
5319 if
5320 (defined $parent) {
5321 $parent->
5322 remove_child
5323 ($source);
5324 } elsif (defined $oe) {
5325 $oe->
5326 remove_attribute_node
5327 ($source);
5328 }
5329
5330
5331
5332 }
5333
5334
5335 ;}
5336
5337 ;
5338
5339 $r = $source;
5340 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
5348 if ($old_od eq $self) {
5349 last ADOPT;
5350 }
5351
5352 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 }
5367
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 }
5384
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 }
5403
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 }
5428
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 5
5438 ,
5439 $key, $src_ud->{$key}->[0], $src,
5440 undef
5441 );
5442 }
5443 }
5444 }
5445 } # ADOPT
5446
5447
5448 }
5449 $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 1
5474 ;
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 }
5496
5497
5498 ;}
5499
5500 ;
5501
5502
5503 }
5504 $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 }
5538
5539 ;
5540
5541
5542 }
5543 $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 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:1148810725:4054:uUDJ249673+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest';
5553
5554 ;
5555
5556
5557
5558 {
5559
5560
5561 $namespaceURI = undef;
5562
5563
5564
5565 }
5566
5567 ;
5568 }
5569
5570
5571 }
5572 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 }
5645
5646 ;
5647
5648
5649 }
5650 $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 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:1148810725:4054:uUDJ249673+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest';
5669
5670 ;
5671
5672
5673
5674 {
5675
5676
5677 $namespaceURI = undef;
5678
5679
5680
5681 }
5682
5683 ;
5684 }
5685
5686
5687 }
5688 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 }
5710
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 }
5727
5728 ;
5729 }
5730
5731
5732 }
5733 $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 }
5753
5754 ;
5755
5756
5757 {
5758
5759
5760 $self->{
5761 'b'
5762 }->{${$self->{
5763 'id'
5764 }}}
5765 ->{'buri'} = $given;
5766
5767
5768 }
5769
5770 ;
5771
5772
5773 }
5774 }
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 }
5795
5796 ;
5797
5798
5799 }
5800 $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 }
5820
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 }
5836
5837 ;
5838
5839
5840 }
5841 }
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 our $VERSION = 20060618.0208;
5878 package Message::DOM::Document::ManakaiDOMDocumentFragment;
5879 our $VERSION = 20060618.0208;
5880 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 }
5921
5922 ;
5923 $r = $obj;
5924
5925
5926 }
5927 $r}
5928 sub node_type ($;$) {
5929 if (@_ == 1) {my ($self) = @_;
5930 my $r;
5931 $r = 11;
5932 $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 3 => 1,
5980 5 => 1,
5981 1 => 1,
5982 7 => 1,
5983 4 => 1,
5984 8 => 1,
5985 }->{$child_nt}) {
5986 push @new_child, $newChild;
5987 } elsif ($child_nt ==
5988 11
5989 ) {
5990 for my $cn (@{$newChild->
5991 child_nodes
5992 }) {
5993 unless ({
5994 3 => 1,
5995 5 => 1,
5996 1 => 1,
5997 7 => 1,
5998 4 => 1,
5999 8 => 1,
6000 }->{$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 }
6015
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 }
6036
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 }
6064
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 }
6087
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 }
6110
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 11
6129 ) {
6130
6131
6132 {
6133
6134
6135 $newChild->{
6136 'b'
6137 }->{${$newChild->{
6138 'id'
6139 }}}
6140 ->{'child'} = [];
6141
6142
6143 }
6144
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 }
6162
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 }
6194
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 }
6213
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 }
6232
6233 ;
6234
6235
6236
6237 ;
6238
6239
6240
6241 ;
6242
6243
6244
6245 }
6246
6247
6248 ;}
6249
6250 ;
6251
6252
6253 }
6254
6255 ;
6256
6257
6258 }
6259 $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 3 => 1,
6303 5 => 1,
6304 1 => 1,
6305 7 => 1,
6306 4 => 1,
6307 8 => 1,
6308 }->{$child_nt}) {
6309 push @new_child, $newChild;
6310 } elsif ($child_nt ==
6311 11
6312 ) {
6313 for my $cn (@{$newChild->
6314 child_nodes
6315 }) {
6316 unless ({
6317 3 => 1,
6318 5 => 1,
6319 1 => 1,
6320 7 => 1,
6321 4 => 1,
6322 8 => 1,
6323 }->{$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 }
6338
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 }
6359
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 }
6387
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 }
6410
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 }
6433
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 }
6467
6468
6469 ;}
6470
6471 ;
6472
6473
6474
6475 }
6476
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 }
6513
6514
6515 ;}
6516
6517 ;
6518
6519
6520
6521 }
6522
6523 ;
6524
6525
6526 ;
6527 } # C
6528 } else { # |oldChild| is not defined
6529
6530
6531 ;
6532 }
6533
6534
6535
6536 }
6537
6538 ; # FOR !tc:ForAppendChild
6539
6540 ## -- Removes from parent
6541 if ($nc_parent) {
6542 if ($child_nt ==
6543 11
6544 ) {
6545
6546
6547 {
6548
6549
6550 $newChild->{
6551 'b'
6552 }->{${$newChild->{
6553 'id'
6554 }}}
6555 ->{'child'} = [];
6556
6557
6558 }
6559
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 }
6577
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 }
6609
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 }
6628
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 }
6659
6660 ;
6661
6662
6663
6664 ;
6665
6666
6667
6668 }
6669
6670
6671 ;}
6672
6673 ;
6674
6675
6676 }
6677
6678 ;
6679
6680
6681 }
6682 $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 3 => 1,
6726 5 => 1,
6727 1 => 1,
6728 7 => 1,
6729 4 => 1,
6730 8 => 1,
6731 }->{$child_nt}) {
6732 push @new_child, $newChild;
6733 } elsif ($child_nt ==
6734 11
6735 ) {
6736 for my $cn (@{$newChild->
6737 child_nodes
6738 }) {
6739 unless ({
6740 3 => 1,
6741 5 => 1,
6742 1 => 1,
6743 7 => 1,
6744 4 => 1,
6745 8 => 1,
6746 }->{$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 }
6761
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 }
6782
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 }
6810
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 }
6833
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 }
6856
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 }
6893
6894
6895 ;}
6896
6897 ;
6898
6899
6900
6901 }
6902
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 }
6939
6940
6941 ;}
6942
6943 ;
6944
6945
6946
6947 }
6948
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 }
6967
6968
6969 ;}
6970
6971 ;
6972
6973
6974
6975 }
6976
6977 ;
6978 }
6979
6980
6981
6982 }
6983
6984 ; # FOR !tc:ForAppendChild
6985
6986 ## -- Removes from parent
6987 if ($nc_parent) {
6988 if ($child_nt ==
6989 11
6990 ) {
6991
6992
6993 {
6994
6995
6996 $newChild->{
6997 'b'
6998 }->{${$newChild->{
6999 'id'
7000 }}}
7001 ->{'child'} = [];
7002
7003
7004 }
7005
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 }
7023
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 }
7055
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 }
7074
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 }
7110
7111 ;
7112 $r = $oldChild;
7113
7114
7115
7116 }
7117
7118 ;
7119
7120
7121
7122 }
7123
7124
7125 ;}
7126
7127 ;
7128
7129
7130 }
7131
7132 ;
7133
7134
7135 }
7136 $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 3
7169 ) {
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 }
7191
7192
7193 ;}
7194
7195 ;
7196
7197
7198 }
7199 $r}
7200 sub get_feature ($$$) {
7201 my ($self, $feature, $version) = @_;
7202
7203 {
7204
7205
7206 $feature = lc $feature;
7207
7208
7209 }
7210
7211 {
7212
7213
7214 $version = '' unless defined $version;
7215
7216
7217 }
7218 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 }
7265
7266 ;
7267 last CLASS;
7268 }
7269 } # CLASS
7270 }
7271
7272
7273 }
7274
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 }
7292
7293
7294 ;}
7295
7296 ;
7297 }
7298
7299
7300 }
7301 $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 }
7326
7327
7328 ;}
7329
7330 ;
7331
7332
7333 }
7334 $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