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

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

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

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