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

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

Parent Directory Parent Directory | Revision Log Revision Log

Revision 1.8 - (hide annotations) (download)
Sat Nov 4 17:25:06 2006 UTC (18 years ago) by wakaba
Branch: MAIN
Changes since 1.7: +14 -15 lines 
++ manakai/lib/Message/Util/DIS/ChangeLog	4 Nov 2006 17:22:49 -0000
2006-11-05  Wakaba  <wakaba@suika.fam.cx>

	* DNLite.dis (DISImplementationDNLite): Inheritance
	was incorrect.

	* Test.dis (DTImplementation): Inheritance was incorrect.

++ manakai/lib/Message/DOM/ChangeLog	4 Nov 2006 17:21:44 -0000
2006-11-05  Wakaba  <wakaba@suika.fam.cx>

	* Element.dis (___get_node_ref): |eval|ed |require|
	statement was broken.

	* DOMFeature.dis (getImplementationList): Argument
	is not passed to the |getImplementation| method.

	* TreeStore.dis (DOMImplementationTreeStore): It
	did not |f:implements| the |TSFeature30| feature.

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