1 |
#!/usr/bin/perl |
## NOTE: This module will be renamed as Document.pm. |
|
## This file is automatically generated |
|
|
## at 2006-04-04T09:22:34+00:00, |
|
|
## from file "Document.dis", |
|
|
## module <http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#ManakaiDOM.Document>, |
|
|
## for <http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#ManakaiDOMLatest>. |
|
|
## Don't edit by hand! |
|
|
use strict; |
|
|
require Message::DOM::DOMCore; |
|
|
require Message::DOM::Element; |
|
|
require Message::DOM::TreeCore; |
|
|
require Message::Util::Error::DOMException; |
|
|
package Message::DOM::Document; |
|
|
our $VERSION = 20060404.0922; |
|
|
package Message::DOM::IFLatest::Document; |
|
|
our $VERSION = 20060404.0922; |
|
|
package Message::DOM::Document::ManakaiDOMDocument; |
|
|
our $VERSION = 20060404.0922; |
|
|
push our @ISA, 'Message::DOM::TreeCore::ManakaiDOMNode', |
|
|
'Message::DOM::IF::Document', |
|
|
'Message::DOM::IF::Node', |
|
|
'Message::DOM::IFLatest::Document', |
|
|
'Message::DOM::IFLatest::Node', |
|
|
'Message::DOM::IFLevel1::Document', |
|
|
'Message::DOM::IFLevel1::Node', |
|
|
'Message::DOM::IFLevel2::Document', |
|
|
'Message::DOM::IFLevel2::Node', |
|
|
'Message::DOM::IFLevel3::Document', |
|
|
'Message::DOM::IFLevel3::Node'; |
|
|
use Char::Class::XML 'InXMLNCNameChar10', |
|
|
'InXMLNCNameChar11', |
|
|
'InXMLNCNameStartChar11', |
|
|
'InXMLNameChar10', |
|
|
'InXMLNameChar11', |
|
|
'InXMLNameStartChar11', |
|
|
'InXML_NCNameStartChar10', |
|
|
'InXML_NameStartChar10'; |
|
|
sub ___create_node_stem ($$$$) { |
|
|
my ($self, $bag, $obj, $opt) = @_; |
|
|
my $r = {}; |
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$obj->{ |
|
|
'child' |
|
|
} = []; |
|
|
$obj->{ |
|
|
'do' |
|
|
} = {}; |
|
|
$obj->{ |
|
|
'http://www.w3.org/2001/04/infoset#version' |
|
|
} = '1.0'; |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$obj->{'impl'} = $opt->{'impl'}->{ |
|
|
'id' |
|
|
}; |
|
|
$bag->{${$opt->{'impl'}->{ |
|
|
'id' |
|
|
}}} |
|
|
->{'lpmi'}->{${$obj->{ |
|
|
'id' |
|
|
}}} |
|
|
= $obj->{ |
|
|
'id' |
|
|
}; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
$r = $obj; |
|
|
|
|
|
|
|
|
} |
|
|
$r} |
|
|
sub ___create_node_ref ($$$) { |
|
|
my ($self, $obj, $opt) = @_; |
|
|
my $r; |
|
|
|
|
|
{ |
|
|
|
|
|
my |
|
|
$class; |
|
|
CLS: { |
|
|
if (defined $opt->{ |
|
|
'nrcls' |
|
|
}) { |
|
|
$class = $opt->{ |
|
|
'nrcls' |
|
|
}; |
|
|
IFCHK: { |
|
|
for (@{$opt->{ |
|
|
'nrifs' |
|
|
} or []}) { |
|
|
last IFCHK unless $$class->isa ($_); |
|
|
} |
|
|
last CLS; |
|
|
} # IFCHK |
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
{ |
|
2 |
|
|
3 |
|
package Message::DOM::Document; |
4 |
|
use strict; |
5 |
|
our $VERSION=do{my @r=(q$Revision$=~/\d+/g);sprintf "%d."."%02d" x $#r,@r}; |
6 |
|
push our @ISA, 'Message::DOM::Node', 'Message::IF::Document', |
7 |
|
'Message::IF::DocumentTraversal', 'Message::IF::DocumentXDoctype', |
8 |
|
'Message::IF::DocumentSelector', # MUST in Selectors API spec |
9 |
|
'Message::IF::HTMLDocument'; |
10 |
|
require Message::DOM::Node; |
11 |
|
use Char::Class::XML |
12 |
|
qw/ |
13 |
|
InXML_NameStartChar10 InXMLNameStartChar11 |
14 |
|
InXMLNameChar10 InXMLNameChar11 |
15 |
|
InXML_NCNameStartChar10 InXMLNCNameStartChar11 |
16 |
|
InXMLNCNameChar10 InXMLNCNameChar11 |
17 |
|
/; |
18 |
|
|
19 |
|
sub ____new ($$) { |
20 |
|
my $self = shift->SUPER::____new (undef); |
21 |
|
$$self->{implementation} = $_[0]; |
22 |
|
$$self->{strict_error_checking} = 1; |
23 |
|
$$self->{child_nodes} = []; |
24 |
|
$$self->{'http://suika.fam.cx/www/2006/dom-config/strict-document-children'} = 1; |
25 |
|
$$self->{'http://suika.fam.cx/www/2006/dom-config/dtd-default-attribute'} = 1; |
26 |
|
$$self->{'http://suika.fam.cx/www/2006/dom-config/clone-entity-reference-subtree'} = 1; |
27 |
|
$$self->{'error-handler'} = sub ($) { |
28 |
|
## NOTE: Same as one set by |setParameter| with |undef| value. |
29 |
|
warn $_[0]; |
30 |
|
return $_[0]->severity != 3; # SEVERITY_FATAL_ERROR |
31 |
|
}; |
32 |
|
return $self; |
33 |
|
} # ____new |
34 |
|
|
35 |
|
sub AUTOLOAD { |
36 |
|
my $method_name = our $AUTOLOAD; |
37 |
|
$method_name =~ s/.*:://; |
38 |
|
return if $method_name eq 'DESTROY'; |
39 |
|
|
40 |
$class = $obj->{ |
if ({ |
41 |
'b' |
## Read-only attributes (trivial accessors) |
42 |
}->{${$obj->{ |
implementation => 1, |
43 |
'id' |
}->{$method_name}) { |
44 |
}}} |
no strict 'refs'; |
45 |
->{'dnrcls'}; |
eval qq{ |
46 |
|
sub $method_name (\$) { |
47 |
|
return \${\$_[0]}->{$method_name}; |
48 |
} |
} |
49 |
|
}; |
50 |
; |
goto &{ $AUTOLOAD }; |
51 |
if (defined $class) { |
} elsif ({ |
52 |
IFCHK: { |
## Read-write attributes (DOMString, trivial accessors) |
53 |
for (@{$opt->{ |
document_uri => 1, |
54 |
'nrifs' |
input_encoding => 1, |
55 |
} or []}) { |
}->{$method_name}) { |
56 |
last IFCHK unless $$class->isa ($_); |
no strict 'refs'; |
57 |
|
eval qq{ |
58 |
|
sub $method_name (\$;\$) { |
59 |
|
if (\@_ > 1) { |
60 |
|
if (\${\$_[0]}->{strict_error_checking} and |
61 |
|
\${\$_[0]}->{manakai_read_only}) { |
62 |
|
report Message::DOM::DOMException |
63 |
|
-object => \$_[0], |
64 |
|
-type => 'NO_MODIFICATION_ALLOWED_ERR', |
65 |
|
-subtype => 'READ_ONLY_NODE_ERR'; |
66 |
|
} |
67 |
|
if (defined \$_[1]) { |
68 |
|
\${\$_[0]}->{$method_name} = ''.\$_[1]; |
69 |
|
} else { |
70 |
|
delete \${\$_[0]}->{$method_name}; |
71 |
|
} |
72 |
|
} |
73 |
|
return \${\$_[0]}->{$method_name}; |
74 |
} |
} |
75 |
last CLS; |
}; |
76 |
} # IFCHK |
goto &{ $AUTOLOAD }; |
77 |
|
} elsif ({ |
78 |
|
## Read-write attributes (boolean, trivial accessors) |
79 |
|
all_declarations_processed => 1, |
80 |
|
}->{$method_name}) { |
81 |
|
no strict 'refs'; |
82 |
|
eval qq{ |
83 |
|
sub $method_name (\$;\$) { |
84 |
|
if (\@_ > 1) { |
85 |
|
if (\${\$_[0]}->{manakai_strict_error_checking} and |
86 |
|
\${\$_[0]}->{manakai_read_only}) { |
87 |
|
report Message::DOM::DOMException |
88 |
|
-object => \$_[0], |
89 |
|
-type => 'NO_MODIFICATION_ALLOWED_ERR', |
90 |
|
-subtype => 'READ_ONLY_NODE_ERR'; |
91 |
|
} |
92 |
|
if (\$_[1]) { |
93 |
|
\${\$_[0]}->{$method_name} = 1; |
94 |
|
} else { |
95 |
|
delete \${\$_[0]}->{$method_name}; |
96 |
|
} |
97 |
|
} |
98 |
|
return \${\$_[0]}->{$method_name}; |
99 |
|
} |
100 |
|
}; |
101 |
|
goto &{ $AUTOLOAD }; |
102 |
|
} elsif (my $module_name = { |
103 |
|
can_dispatch => 'Message::DOM::EventTargetNode', |
104 |
|
create_attribute => 'Message::DOM::Attr', |
105 |
|
create_attribute_ns => 'Message::DOM::Attr', |
106 |
|
create_attribute_definition => 'Message::DOM::AttributeDefinition', |
107 |
|
create_cdata_section => 'Message::DOM::Text', |
108 |
|
create_comment => 'Message::DOM::CharacterData', |
109 |
|
create_document_fragment => 'Message::DOM::DocumentFragment', |
110 |
|
create_document_type_definition => 'Message::DOM::DocumentType', |
111 |
|
create_element => 'Message::DOM::Element', |
112 |
|
create_element_ns => 'Message::DOM::Element', |
113 |
|
create_element_type_definition => 'Message::DOM::ElementTypeDefinition', |
114 |
|
create_entity_reference => 'Message::DOM::EntityReference', |
115 |
|
create_event => 'Message::DOM::EventTargetNode', |
116 |
|
create_general_entity => 'Message::DOM::Entity', |
117 |
|
create_notation => 'Message::DOM::Notation', |
118 |
|
create_processing_instruction => 'Message::DOM::ProcessingInstruction', |
119 |
|
manakai_create_serial_walker => 'Message::DOM::SerialWalker', |
120 |
|
create_text_node => 'Message::DOM::Text', |
121 |
|
create_tree_walker => 'Message::DOM::TreeWalker', |
122 |
|
query_selector => 'Message::DOM::SelectorsAPI', |
123 |
|
query_selector_all => 'Message::DOM::SelectorsAPI', |
124 |
|
}->{$method_name}) { |
125 |
|
eval qq{ require $module_name } or die $@; |
126 |
|
goto &{ $AUTOLOAD }; |
127 |
|
} else { |
128 |
|
require Carp; |
129 |
|
Carp::croak (qq<Can't locate method "$AUTOLOAD">); |
130 |
|
} |
131 |
|
} # AUTOLOAD |
132 |
|
sub implementation ($); |
133 |
|
sub create_attribute ($$); |
134 |
|
sub create_attribute_ns ($$$); |
135 |
|
sub create_attribute_definition ($$); |
136 |
|
sub create_cdata_section ($$); |
137 |
|
sub create_comment ($$); |
138 |
|
sub create_document_fragment ($); |
139 |
|
sub create_document_type_definition ($$); |
140 |
|
sub create_element ($$); |
141 |
|
sub create_element_ns ($$$); |
142 |
|
sub create_element_type_definition ($$); |
143 |
|
sub create_entity_reference ($$); |
144 |
|
sub create_general_entity ($$); |
145 |
|
sub create_notation ($$); |
146 |
|
sub create_processing_instruction ($$$); |
147 |
|
sub create_text_node ($$); |
148 |
|
|
149 |
|
## |Node| attributes |
150 |
|
|
151 |
|
sub base_uri ($) { |
152 |
|
my $v = ${$_[0]}->{manakai_entity_base_uri}; |
153 |
|
if (defined $v) { |
154 |
|
return $v; |
155 |
|
} else { |
156 |
|
return ${$_[0]}->{document_uri}; |
157 |
} |
} |
158 |
|
## TODO: HTML5 <base> |
159 |
|
} # base_uri |
160 |
|
|
161 |
my $cns; |
sub node_name () { '#document' } |
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$cns = $obj->{ |
|
|
'b' |
|
|
}->{${$obj->{ |
|
|
'id' |
|
|
}}} |
|
|
->{'child'}; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
my $bag = |
|
|
$obj->{'b'} |
|
|
; |
|
|
my $deh; |
|
|
DC: for my $cnid (@$cns) { |
|
|
my $cnh = |
|
|
{ |
|
|
'id' => $cnid, |
|
|
'b' => $bag, |
|
|
} |
|
|
; |
|
|
my $cncls; |
|
|
|
|
|
|
|
|
{ |
|
162 |
|
|
163 |
|
sub node_type () { 9 } # DOCUMENT_NODE |
164 |
|
|
165 |
$cncls = $cnh->{ |
sub text_content ($;$) { |
166 |
'b' |
my $self = shift; |
167 |
}->{${$cnh->{ |
if ($$self->{'http://suika.fam.cx/www/2006/dom-config/strict-document-children'}) { |
168 |
'id' |
return undef; |
169 |
}}} |
} else { |
170 |
->{'cls'}; |
local $Error::Depth = $Error::Depth + 1; |
171 |
|
return $self->SUPER::text_content (@_); |
172 |
|
} |
173 |
} |
} # text_content |
|
|
|
|
; |
|
|
if ($$cncls eq |
|
|
'Message::DOM::Element::ManakaiDOMElement' |
|
|
) { |
|
|
$deh = $cnh; |
|
|
last DC; |
|
|
} |
|
|
} # DC |
|
|
my $dens; |
|
|
my $deln; |
|
|
if (defined $deh) { |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
174 |
|
|
175 |
$dens = $deh->{ |
## |Node| methods |
|
'b' |
|
|
}->{${$deh->{ |
|
|
'id' |
|
|
}}} |
|
|
->{'ns'}; |
|
176 |
|
|
177 |
|
sub adopt_node ($$) { |
178 |
|
my ($self, $source) = @_; |
179 |
|
## TODO: Should we apply |copy-asis| configuration parameter to this method? |
180 |
|
|
181 |
} |
return undef unless UNIVERSAL::isa ($source, 'Message::DOM::Node'); |
182 |
|
|
183 |
; |
my $strict = $self->strict_error_checking; |
184 |
$dens = \'' unless defined $dens; |
if ($strict and $$self->{manakai_read_only}) { |
185 |
|
report Message::DOM::DOMException |
186 |
|
-object => $self, |
187 |
|
-type => 'NO_MODIFICATION_ALLOWED_ERR', |
188 |
|
-subtype => 'READ_ONLY_NODE_ERR'; |
189 |
|
} |
190 |
|
|
191 |
{ |
my $parent = $source->parent_node; |
192 |
|
if ($strict and defined $parent and $$parent->{manakai_read_only}) { |
193 |
|
report Message::DOM::DOMException |
194 |
|
-object => $self, |
195 |
|
-type => 'NO_MODIFICATION_ALLOWED_ERR', |
196 |
|
-subtype => 'READ_ONLY_NODE_ERR'; |
197 |
|
} |
198 |
|
|
199 |
|
my $nt = $source->node_type; |
200 |
|
my $oe; |
201 |
|
if ($nt == 2) { # ATTRIBUTE_NODE |
202 |
|
$oe = $source->owner_element; |
203 |
|
if ($strict and defined $oe and $$oe->{manakai_read_only}) { |
204 |
|
report Message::DOM::DOMException |
205 |
|
-object => $self, |
206 |
|
-type => 'NO_MODIFICATION_ALLOWED_ERR', |
207 |
|
-subtype => 'READ_ONLY_NODE_ERR'; |
208 |
|
} |
209 |
|
} elsif ($nt == 9 or $nt == 10 or $nt == 6 or $nt == 12 or |
210 |
|
$nt == 81001 or $nt == 81002) { |
211 |
|
# DOCUMENT_NODE, DOCUMENT_TYPE_NODE, ENTITY_NODE, NOTATION_NODE, |
212 |
|
# ELEMENT_TYPE_DEFINITION_NODE, ATTRIBUTE_DEFINITION_NODE |
213 |
|
report Message::DOM::DOMException |
214 |
|
-object => $self, |
215 |
|
-type => 'NOT_SUPPORTED_ERR', |
216 |
|
-subtype => 'ADOPT_NODE_TYPE_NOT_SUPPORTED_ERR'; |
217 |
|
## ISSUE: Define ELEMENT_TYPE_DEFINITION_NODE and ATTRIBUTE_DEFINITION_NODE |
218 |
|
} |
219 |
|
|
220 |
$deln = $deh->{ |
my @change_od; |
221 |
'b' |
my @nodes = ($source); |
222 |
}->{${$deh->{ |
while (@nodes) { |
223 |
'id' |
my $node = shift @nodes; |
224 |
}}} |
my $nt = $node->node_type; |
225 |
->{'ln'}; |
if ($strict and $$node->{manakai_read_only}) { |
226 |
|
report Message::DOM::DOMException |
227 |
|
-object => $self, |
228 |
|
-type => 'NO_MODIFICATION_ALLOWED_ERR', |
229 |
|
-subtype => 'READ_ONLY_NODE_ERR'; |
230 |
|
} |
231 |
|
|
232 |
|
push @change_od, $node; |
233 |
|
push @nodes, @{$node->child_nodes}, @{$node->attributes or []}; |
234 |
|
} # @nodes |
235 |
|
|
236 |
} |
local $Error::Depth = $Error::Depth + 1; |
237 |
|
|
238 |
; |
if (defined $parent) { |
239 |
} else { |
$parent->remove_child ($source); |
240 |
$dens = \'*'; |
} elsif (defined $oe) { |
241 |
$deln = \'*'; |
$oe->remove_attribute_node ($source); |
242 |
} |
} |
243 |
|
|
244 |
A: { |
return $source if $self eq $change_od[0]->owner_document; |
245 |
## Use cases: |
## NOTE: The array must have more than zero |
246 |
## - Document element is |html5:html| |
## nodes by definition. In addition, |
247 |
## - Document element is |NULL:rfc| |
## it cannot contain document or document |
248 |
|
## type nodes in current implementation. |
249 |
for my $nm ( |
|
250 |
[$dens, $deln], |
my @ud_node; |
251 |
[$dens, \'*'], |
for my $n (@change_od) { |
252 |
) { |
$$n->{owner_document} = $self; |
253 |
for my $__class (sort { |
Scalar::Util::weaken ($$n->{owner_document}); |
254 |
$Message::DOM::ClassPoint{$b} <=> $Message::DOM::ClassPoint{$a} |
if ($$n->{user_data}) { |
255 |
} grep { |
push @ud_node, $n; |
|
$Message::DOM::DOMFeature::ClassInfo |
|
|
->{ |
|
|
'Message::DOM::Document::ManakaiDOMDocument' |
|
|
} |
|
|
->{compat_class_by_type} |
|
|
->{${$nm->[0]}}->{${$nm->[1]}}->{$_} |
|
|
} keys %{$Message::DOM::DOMFeature::ClassInfo |
|
|
->{ |
|
|
'Message::DOM::Document::ManakaiDOMDocument' |
|
|
} |
|
|
->{compat_class_by_type} |
|
|
->{${$nm->[0]}}->{${$nm->[1]}} or {}}) { |
|
|
if ($Message::DOM::DOMFeature::ClassInfo->{$__class} |
|
|
->{has_feature}->{xml}->{'3.0'}) { |
|
|
$class = \$__class; |
|
|
IFCHK: { |
|
|
for (@{$opt->{ |
|
|
'nrifs' |
|
|
} or []}) { |
|
|
last IFCHK unless $$class->isa ($_); |
|
|
} |
|
|
last A; |
|
|
} # IFCHK |
|
|
} |
|
|
} |
|
256 |
} |
} |
257 |
|
} |
258 |
|
|
259 |
## Generic |
for my $src (@ud_node) { |
260 |
CLASS: for my $__class (sort { |
my $src_ud = $$src->{user_data}; |
261 |
$Message::DOM::ClassPoint{$b} <=> $Message::DOM::ClassPoint{$a} |
for my $key (keys %{$src_ud}) { |
262 |
} grep { |
my $dh = $src_ud->{$key}->[1]; |
263 |
$Message::DOM::DOMFeature::ClassInfo |
if ($dh) { |
264 |
->{ |
$dh->(5, $key, $src_ud->{$key}->[0], $src, undef); # NODE_ADOPTED |
|
'Message::DOM::Document::ManakaiDOMDocument' |
|
|
} |
|
|
->{compat_class}->{$_} |
|
|
} keys %{$Message::DOM::DOMFeature::ClassInfo |
|
|
->{ |
|
|
'Message::DOM::Document::ManakaiDOMDocument' |
|
|
} |
|
|
->{compat_class} or {}}) { |
|
|
if ($Message::DOM::DOMFeature::ClassInfo->{$__class} |
|
|
->{has_feature}->{xml}->{'3.0'}) { |
|
|
$class = \$__class; |
|
|
IFCHK: { |
|
|
for (@{$opt->{ |
|
|
'nrifs' |
|
|
} or []}) { |
|
|
last IFCHK unless $$class->isa ($_); |
|
|
} |
|
|
last A; |
|
|
} # IFCHK |
|
265 |
} |
} |
266 |
} |
} |
|
|
|
|
## Default |
|
|
$class = \$self; |
|
|
} # A |
|
|
|
|
|
if (defined $deh) { |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$obj->{ |
|
|
'b' |
|
|
}->{${$obj->{ |
|
|
'id' |
|
|
}}} |
|
|
->{'dnrcls'} = $class; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
267 |
} |
} |
|
} # CLS |
|
|
$r = bless $obj, $$class; |
|
268 |
|
|
269 |
|
return $source; |
270 |
|
} # adopt_node |
271 |
|
|
|
} |
|
|
$r} |
|
|
sub node_type ($;$) { |
|
|
if (@_ == 1) {my ($self) = @_; |
|
|
my $r; |
|
|
$r = '9'; |
|
|
$r; |
|
|
} else {my ($self) = @_; |
|
|
report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Document::ManakaiDOMDocument', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'node_type'; |
|
|
} |
|
|
} |
|
272 |
sub append_child ($$) { |
sub append_child ($$) { |
273 |
my ($self, $newChild) = @_; |
## NOTE: Overrides |Node|'s implementation. |
274 |
my $r; |
my $self = $_[0]; |
|
|
|
|
{ |
|
|
|
|
|
my |
|
|
$strictc = $self-> |
|
|
dom_config |
|
|
|
|
|
-> |
|
|
get_parameter |
|
|
|
|
|
( |
|
|
'http://suika.fam.cx/www/2006/dom-config/strict-document-children' |
|
|
); |
|
|
my $child_od = $newChild-> |
|
|
owner_document |
|
|
|| $self; |
|
|
my $child_nt = $newChild-> |
|
|
node_type |
|
|
; |
|
|
if ($strictc and $self-> |
|
|
strict_error_checking |
|
|
) { |
|
275 |
|
|
276 |
|
## NOTE: |$self_od| code here in some $self->node_type. |
277 |
|
|
278 |
{ |
## -- Node Type check |
279 |
|
my @new_child; |
280 |
local $Error::Depth = $Error::Depth + 1; |
my $new_child_parent; |
281 |
|
if ($_[1]->node_type == 11) { # DOCUMENT_FRAGMENT_NODE |
282 |
{ |
push @new_child, @{$_[1]->child_nodes}; |
283 |
|
$new_child_parent = $_[1]; |
284 |
|
} else { |
285 |
my |
@new_child = ($_[1]); |
286 |
$has_el; |
$new_child_parent = $_[1]->parent_node; |
287 |
my $has_dt; |
} |
288 |
if ($child_nt == |
|
289 |
'1' |
## NOTE: Depends on $self->node_type: |
290 |
) { |
if ($$self->{strict_error_checking}) { |
291 |
$has_el = |
my $child_od = $_[1]->owner_document || $_[1]; # might be DocumentType |
292 |
1 |
if ($self ne $child_od and $child_od->node_type != 10) { |
293 |
; |
report Message::DOM::DOMException # DOCUMENT_TYPE_NODE |
294 |
} elsif ($child_nt == |
-object => $self, |
295 |
'10' |
-type => 'WRONG_DOCUMENT_ERR', |
296 |
) { |
-subtype => 'EXTERNAL_OBJECT_ERR'; |
297 |
$has_dt = |
} |
298 |
1 |
|
299 |
; |
if ($$self->{manakai_read_only} or |
300 |
} elsif ($child_nt == |
(@new_child and defined $new_child_parent and |
301 |
'11' |
$$new_child_parent->{manakai_read_only})) { |
302 |
) { |
report Message::DOM::DOMException |
303 |
for my $cn (@{$newChild-> |
-object => $self, |
304 |
child_nodes |
-type => 'NO_MODIFICATION_ALLOWED_ERR', |
305 |
}) { |
-subtype => 'READ_ONLY_NODE_ERR'; |
306 |
my $cnt = $cn-> |
} |
307 |
node_type |
|
308 |
; |
## NOTE: Only in |Document|: |
309 |
if ($cnt == |
my $strict_children = $self->dom_config->get_parameter |
310 |
'1' |
(q<http://suika.fam.cx/www/2006/dom-config/strict-document-children>); |
311 |
) { |
if ($strict_children) { |
312 |
if ($has_el) { |
my $has_el; |
313 |
|
my $has_dt; |
314 |
|
my $child_nt = $_[1]->node_type; |
315 |
{ |
if ($child_nt == 1) { # ELEMENT_NODE |
316 |
|
$has_el = 1; |
317 |
local $Error::Depth = $Error::Depth - 1; |
} elsif ($child_nt == 10) { # DOCUMENT_TYPE_NODE |
318 |
|
$has_dt = 1; |
319 |
{ |
} elsif ($child_nt == 11) { # DOCUMENT_FRAGMENT_NODE |
320 |
|
for my $cn (@{$_[1]->child_nodes}) { |
321 |
report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'HIERARCHY_REQUEST_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'append_child', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#MDOM_SECOND_DOC_ELEMENT', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Document::ManakaiDOMDocument', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => 'newChild', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#node' => $newChild; |
my $cnt = $cn->node_type; |
322 |
|
if ($cnt == 1) { # ELEMENT_NODE |
323 |
|
if ($has_el) { |
324 |
} |
report Message::DOM::DOMException |
325 |
|
-object => $self, |
326 |
|
-type => 'HIERARCHY_REQUEST_ERR', |
327 |
;} |
-subtype => 'CHILD_NODE_TYPE_ERR'; |
328 |
|
} |
329 |
; |
$has_el = 1; |
330 |
|
} elsif ($cnt == 10) { # DOCUMENT_TYPE_NODE |
331 |
|
## NOTE: |DocumentType| node cannot be contained in |
332 |
|
## |DocumentFragment| in strict mode. |
333 |
|
if ($has_dt) { |
334 |
|
report Message::DOM::DOMException |
335 |
|
-object => $self, |
336 |
|
-type => 'HIERARCHY_REQUEST_ERR', |
337 |
|
-subtype => 'CHILD_NODE_TYPE_ERR'; |
338 |
|
} |
339 |
|
$has_dt = 1; |
340 |
} |
} |
|
$has_el = |
|
|
1 |
|
|
; |
|
341 |
} |
} |
|
# DocumentType node cannot be contained in DocumentFragments |
|
342 |
} |
} |
343 |
} |
|
344 |
|
if ($has_el) { |
345 |
if ($has_el) { |
my $anode = $self->last_child; |
346 |
my $anode = $self-> |
while (defined $anode) { |
347 |
last_child |
if ($anode->node_type == 1) { # ELEMENT_NODE |
348 |
; |
report Message::DOM::DOMException |
349 |
while (defined $anode) { |
-object => $self, |
350 |
if ($anode-> |
-type => 'HIERARCHY_REQUEST_ERR', |
351 |
node_type |
-subtype => 'CHILD_NODE_TYPE_ERR'; |
352 |
== |
} |
353 |
'1' |
$anode = $anode->previous_sibling; |
|
) { |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth - 1; |
|
|
|
|
|
{ |
|
|
|
|
|
report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'HIERARCHY_REQUEST_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'append_child', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#MDOM_SECOND_DOC_ELEMENT', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Document::ManakaiDOMDocument', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => 'newChild', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#node' => $newChild; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
;} |
|
|
|
|
|
; |
|
354 |
} |
} |
355 |
$anode = $anode-> |
} # has_el |
356 |
previous_sibling |
if ($has_dt) { |
357 |
; |
my $anode = $self->last_child; |
358 |
} |
while (defined $anode) { |
359 |
} # has_el |
my $ant = $anode->node_type; |
360 |
if ($has_dt) { |
if ($ant == 1 or $ant == 10) { # ELEMENT_NODE or DOCUMENT_TYPE_NODE |
361 |
my $anode = $self-> |
report Message::DOM::DOMException |
362 |
last_child |
-object => $self, |
363 |
; |
-type => 'HIERARCHY_REQUEST_ERR', |
364 |
while (defined $anode) { |
-subtype => 'CHILD_NODE_TYPE_ERR'; |
365 |
my $ant = $anode-> |
} |
366 |
node_type |
$anode = $anode->previous_sibling; |
|
; |
|
|
if ($ant == |
|
|
'1' |
|
|
) { |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth - 1; |
|
|
|
|
|
{ |
|
|
|
|
|
report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'HIERARCHY_REQUEST_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'append_child', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#HIERARCHY_WRONG_DOCTYPE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Document::ManakaiDOMDocument', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => 'newChild', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#node' => $newChild; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
;} |
|
|
|
|
|
; |
|
|
} elsif ($ant == |
|
|
'10' |
|
|
) { |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth - 1; |
|
|
|
|
|
{ |
|
|
|
|
|
report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'HIERARCHY_REQUEST_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'append_child', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#MDOM_SECOND_DOCTYPE', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Document::ManakaiDOMDocument', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => 'newChild', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#node' => $newChild; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
;} |
|
|
|
|
|
; |
|
367 |
} |
} |
368 |
$anode = $anode-> |
} # has_dt |
369 |
previous_sibling |
} |
|
; |
|
|
} |
|
|
} # has_dt |
|
|
|
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
;} |
|
|
|
|
|
; |
|
|
} |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth + 1; |
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
my |
|
|
$strict = $self-> |
|
|
strict_error_checking |
|
|
; |
|
370 |
|
|
371 |
## -- Node Type check |
for my $cn (@new_child) { |
|
my @new_child; |
|
|
if ({ |
|
|
'3' => (not $strictc), |
|
|
'5' => (not $strictc), |
|
|
'1' => 1, |
|
|
'4' => (not $strictc), |
|
|
'7' => 1, |
|
|
'8' => 1, |
|
|
'10' => 1, |
|
|
}->{$child_nt}) { |
|
|
push @new_child, $newChild; |
|
|
} elsif ($child_nt == |
|
|
'11' |
|
|
) { |
|
|
for my $cn (@{$newChild-> |
|
|
child_nodes |
|
|
}) { |
|
372 |
unless ({ |
unless ({ |
373 |
'3' => (not $strictc), |
3, (not $strict_children), # TEXT_NODE |
374 |
'5' => (not $strictc), |
5, (not $strict_children), # ENTITY_REFERENCE_NODE |
375 |
'1' => 1, |
1, 1, # ELEMENT_NODE |
376 |
'4' => (not $strictc), |
4, (not $strict_children), # CDATA_SECTION_NODE |
377 |
'7' => 1, |
7, 1, # PROCESSING_INSTRUCTION_NODE |
378 |
'8' => 1, |
8, 1, # COMMENT_NODE |
379 |
'10' => 1, |
10, 1, # DOCUMENT_TYPE_NODE |
380 |
}->{$cn-> |
}->{$cn->node_type}) { |
381 |
node_type |
report Message::DOM::DOMException |
382 |
}) { |
-object => $self, |
383 |
|
-type => 'HIERARCHY_REQUEST_ERR', |
384 |
|
-subtype => 'CHILD_NODE_TYPE_ERR'; |
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth - 1; |
|
|
|
|
|
{ |
|
|
|
|
|
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; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
;} |
|
|
|
|
|
; |
|
385 |
} |
} |
|
push @new_child, $cn; |
|
|
} |
|
|
} else { |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth - 1; |
|
|
|
|
|
{ |
|
|
|
|
|
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; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
;} |
|
|
|
|
|
; |
|
|
} |
|
|
|
|
|
my $nc_parent = @new_child ? $new_child[0]-> |
|
|
parent_node |
|
|
: |
|
|
|
|
|
undef |
|
|
; |
|
|
if ($strict) { |
|
|
## -- Wrong-document check |
|
|
unless ($self eq $child_od) { |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth - 1; |
|
|
|
|
|
{ |
|
|
|
|
|
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; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
;} |
|
|
|
|
|
; |
|
386 |
} |
} |
387 |
|
|
388 |
## -- Read-onlyness check |
## NOTE: Ancestor check here in |Node|. |
|
if ($self-> |
|
|
manakai_read_only |
|
|
) { |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth - 1; |
|
|
|
|
|
{ |
|
|
|
|
|
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'; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
;} |
|
|
|
|
|
; |
|
|
} |
|
|
if (@new_child) { |
|
|
if ($nc_parent and |
|
|
$nc_parent-> |
|
|
manakai_read_only |
|
|
) { |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth - 1; |
|
|
|
|
|
{ |
|
|
|
|
|
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'; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
;} |
|
|
|
|
|
; |
|
|
} |
|
|
} |
|
389 |
} |
} |
390 |
|
|
391 |
## -- Insert at... |
## NOTE: "Insert at" code only in insert_before and replace_child |
|
my $index = -1; # last |
|
|
|
|
|
|
|
|
; # FOR !tc:ForAppendChild |
|
392 |
|
|
393 |
## -- Removes from parent |
## -- Removes from parent |
394 |
if ($nc_parent) { |
if ($new_child_parent) { |
395 |
if ($child_nt == |
if (@new_child == 1) { |
396 |
'11' |
my $v = $$new_child_parent->{child_nodes}; |
|
) { |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$newChild->{ |
|
|
'b' |
|
|
}->{${$newChild->{ |
|
|
'id' |
|
|
}}} |
|
|
->{'child'} = []; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
} else { |
|
|
my $v; |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$v = $nc_parent->{ |
|
|
'b' |
|
|
}->{${$nc_parent->{ |
|
|
'id' |
|
|
}}} |
|
|
->{'child'}; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
397 |
RP: for my $i (0..$#$v) { |
RP: for my $i (0..$#$v) { |
398 |
my $nodeid = $v->[$i]; |
if ($v->[$i] eq $new_child[0]) { |
|
if ( |
|
|
(${$new_child[0]->{'id'}} eq ${$nodeid}) |
|
|
) { |
|
399 |
splice @$v, $i, 1, (); |
splice @$v, $i, 1, (); |
400 |
last RP; |
last RP; |
401 |
} |
} |
402 |
} # RP |
} # RP |
403 |
|
} else { |
404 |
|
@{$$new_child_parent->{child_nodes}} = (); |
405 |
} |
} |
406 |
} |
} |
407 |
|
|
408 |
## -- Rewrite the |parentNode| properties |
## -- Rewrite the |parentNode| properties |
409 |
for my $nc (@new_child) { |
for my $nc (@new_child) { |
410 |
|
$$nc->{parent_node} = $self; |
411 |
|
Scalar::Util::weaken ($$nc->{parent_node}); |
|
{ |
|
|
|
|
|
|
|
|
$nc->{ |
|
|
'b' |
|
|
}->{${$nc->{ |
|
|
'id' |
|
|
}}} |
|
|
->{'parent'} = $self->{ |
|
|
'id' |
|
|
}; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
412 |
} |
} |
413 |
|
|
414 |
my $children; |
## NOTE: Depends on method: |
415 |
|
push @{$$self->{child_nodes}}, @new_child; |
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$children = $self->{ |
|
|
'b' |
|
|
}->{${$self->{ |
|
|
'id' |
|
|
}}} |
|
|
->{'child'}; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
## -- Adds to children list |
|
|
push @$children, map { |
|
|
|
|
|
$_->{'id'} |
|
|
|
|
|
} @new_child; |
|
|
$r = $newChild; |
|
|
|
|
|
|
|
416 |
|
|
417 |
} |
## NOTE: Only in |Document|. |
418 |
|
for (@new_child) { |
419 |
; |
delete $$_->{implementation}; |
420 |
|
$$_->{owner_document} = $self; |
421 |
|
Scalar::Util::weaken ($$_->{owner_document}); |
422 |
|
} |
|
; |
|
|
|
|
|
|
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
;} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
if ($child_nt == |
|
|
'10' and |
|
|
|
|
|
not defined $newChild-> |
|
|
owner_document |
|
|
) { |
|
|
my $bag = |
|
|
$self->{'b'} |
|
|
; |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
CORE::delete |
|
|
$bag->{${$bag->{${$newChild->{ |
|
|
'id' |
|
|
}}} |
|
|
->{'impl'} or \''}} |
|
|
->{'lpmi'}; |
|
|
$bag->{ |
|
|
'm' |
|
|
}++; |
|
|
CORE::delete $bag->{${$newChild->{ |
|
|
'id' |
|
|
}}} |
|
|
->{'impl'}; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$bag->{${$newChild->{ |
|
|
'id' |
|
|
}}}->{'od'} |
|
|
= $self->{ |
|
|
'id' |
|
|
}; |
|
|
$bag->{${$self->{ |
|
|
'id' |
|
|
}}} |
|
|
->{'do'}->{${$newChild->{ |
|
|
'id' |
|
|
}}} |
|
|
= $newChild->{ |
|
|
'id' |
|
|
}; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
} |
|
|
|
|
|
|
|
|
} |
|
|
$r} |
|
|
sub insert_before ($$;$) { |
|
|
my ($self, $newChild, $refChild) = @_; |
|
|
my $r; |
|
|
|
|
|
{ |
|
|
|
|
|
my |
|
|
$strictc = $self-> |
|
|
dom_config |
|
|
|
|
|
-> |
|
|
get_parameter |
|
|
|
|
|
( |
|
|
'http://suika.fam.cx/www/2006/dom-config/strict-document-children' |
|
|
); |
|
|
my $child_od = $newChild-> |
|
|
owner_document |
|
|
|| $self; |
|
|
my $child_nt = $newChild-> |
|
|
node_type |
|
|
; |
|
|
if ($strictc and $self-> |
|
|
strict_error_checking |
|
|
) { |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth + 1; |
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
my |
|
|
$has_el; |
|
|
my $has_dt; |
|
|
if ($child_nt == |
|
|
'1' |
|
|
) { |
|
|
$has_el = |
|
|
1 |
|
|
; |
|
|
} elsif ($child_nt == |
|
|
'10' |
|
|
) { |
|
|
$has_dt = |
|
|
1 |
|
|
; |
|
|
} elsif ($child_nt == |
|
|
'11' |
|
|
) { |
|
|
for my $cn (@{$newChild-> |
|
|
child_nodes |
|
|
}) { |
|
|
my $cnt = $cn-> |
|
|
node_type |
|
|
; |
|
|
if ($cnt == |
|
|
'1' |
|
|
) { |
|
|
if ($has_el) { |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth - 1; |
|
|
|
|
|
{ |
|
|
|
|
|
report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'HIERARCHY_REQUEST_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'insert_before', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#MDOM_SECOND_DOC_ELEMENT', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Document::ManakaiDOMDocument', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => 'newChild', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#node' => $newChild; |
|
423 |
|
|
424 |
|
return $_[1]; |
425 |
|
} # apepnd_child |
426 |
|
|
427 |
} |
sub manakai_append_text ($$) { |
428 |
|
my $self = shift; |
429 |
|
if ($$self->{'http://suika.fam.cx/www/2006/dom-config/strict-document-children'}) { |
430 |
|
# |
431 |
|
} else { |
432 |
|
local $Error::Depth = $Error::Depth + 1; |
433 |
|
return $self->SUPER::manakai_append_text (@_); |
434 |
|
} |
435 |
|
} # manakai_append_text |
436 |
|
|
437 |
|
sub insert_before ($$) { |
438 |
|
## NOTE: Overrides |Node|'s implementation. |
439 |
|
my $self = $_[0]; |
440 |
|
|
441 |
;} |
## NOTE: |$self_od| code here depending on $self->node_type. |
442 |
|
|
443 |
; |
## -- Node Type check |
444 |
|
my @new_child; |
445 |
|
my $new_child_parent; |
446 |
|
if ($_[1]->node_type == 11) { # DOCUMENT_FRAGMENT_NODE |
447 |
|
push @new_child, @{$_[1]->child_nodes}; |
448 |
|
$new_child_parent = $_[1]; |
449 |
|
} else { |
450 |
|
@new_child = ($_[1]); |
451 |
|
$new_child_parent = $_[1]->parent_node; |
452 |
|
} |
453 |
|
|
454 |
|
## NOTE: Depends on $self->node_type: |
455 |
|
if ($$self->{strict_error_checking}) { |
456 |
|
my $child_od = $_[1]->owner_document || $_[1]; # might be DocumentType |
457 |
|
if ($self ne $child_od and $child_od->node_type != 10) { |
458 |
|
report Message::DOM::DOMException # DOCUMENT_TYPE_NODE |
459 |
|
-object => $self, |
460 |
|
-type => 'WRONG_DOCUMENT_ERR', |
461 |
|
-subtype => 'EXTERNAL_OBJECT_ERR'; |
462 |
|
} |
463 |
|
|
464 |
|
if ($$self->{manakai_read_only} or |
465 |
|
(@new_child and defined $new_child_parent and |
466 |
|
$$new_child_parent->{manakai_read_only})) { |
467 |
|
report Message::DOM::DOMException |
468 |
|
-object => $self, |
469 |
|
-type => 'NO_MODIFICATION_ALLOWED_ERR', |
470 |
|
-subtype => 'READ_ONLY_NODE_ERR'; |
471 |
|
} |
472 |
|
|
473 |
|
## NOTE: Only in |Document|: |
474 |
|
my $strict_children = $self->dom_config->get_parameter |
475 |
|
(q<http://suika.fam.cx/www/2006/dom-config/strict-document-children>); |
476 |
|
if ($strict_children) { |
477 |
|
my $has_el; |
478 |
|
my $has_dt; |
479 |
|
my $child_nt = $_[1]->node_type; |
480 |
|
if ($child_nt == 1) { # ELEMENT_NODE |
481 |
|
$has_el = 1; |
482 |
|
} elsif ($child_nt == 10) { # DOCUMENT_TYPE_NODE |
483 |
|
$has_dt = 1; |
484 |
|
} elsif ($child_nt == 11) { # DOCUMENT_FRAGMENT_NODE |
485 |
|
for my $cn (@{$_[1]->child_nodes}) { |
486 |
|
my $cnt = $cn->node_type; |
487 |
|
if ($cnt == 1) { # ELEMENT_NODE |
488 |
|
if ($has_el) { |
489 |
|
report Message::DOM::DOMException |
490 |
|
-object => $self, |
491 |
|
-type => 'HIERARCHY_REQUEST_ERR', |
492 |
|
-subtype => 'CHILD_NODE_TYPE_ERR'; |
493 |
|
} |
494 |
|
$has_el = 1; |
495 |
|
} elsif ($cnt == 10) { # DOCUMENT_TYPE_NODE |
496 |
|
## NOTE: |DocumentType| node cannot be contained in |
497 |
|
## |DocumentFragment| in strict mode. |
498 |
|
if ($has_dt) { |
499 |
|
report Message::DOM::DOMException |
500 |
|
-object => $self, |
501 |
|
-type => 'HIERARCHY_REQUEST_ERR', |
502 |
|
-subtype => 'CHILD_NODE_TYPE_ERR'; |
503 |
|
} |
504 |
|
$has_dt = 1; |
505 |
} |
} |
|
$has_el = |
|
|
1 |
|
|
; |
|
|
} |
|
|
# DocumentType node cannot be contained in DocumentFragments |
|
|
} |
|
|
} |
|
|
|
|
|
if ($has_el) { |
|
|
my $anode = $refChild ? $refChild-> |
|
|
previous_sibling |
|
|
: |
|
|
$self-> |
|
|
last_child |
|
|
; |
|
|
while (defined $anode) { |
|
|
if ($anode-> |
|
|
node_type |
|
|
== |
|
|
'1' |
|
|
) { |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth - 1; |
|
|
|
|
|
{ |
|
|
|
|
|
report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'HIERARCHY_REQUEST_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'insert_before', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#MDOM_SECOND_DOC_ELEMENT', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Document::ManakaiDOMDocument', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => 'newChild', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#node' => $newChild; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
;} |
|
|
|
|
|
; |
|
|
} |
|
|
$anode = $anode-> |
|
|
previous_sibling |
|
|
; |
|
|
} |
|
|
$anode = $refChild; |
|
|
while (defined $anode) { |
|
|
my $ant = $anode-> |
|
|
node_type |
|
|
; |
|
|
if ($ant == |
|
|
'1' |
|
|
) { |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth - 1; |
|
|
|
|
|
{ |
|
|
|
|
|
report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'HIERARCHY_REQUEST_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'insert_before', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#MDOM_SECOND_DOC_ELEMENT', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Document::ManakaiDOMDocument', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => 'newChild', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#node' => $newChild; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
;} |
|
|
|
|
|
; |
|
|
} elsif ($ant == |
|
|
'10' |
|
|
) { |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth - 1; |
|
|
|
|
|
{ |
|
|
|
|
|
report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'HIERARCHY_REQUEST_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'insert_before', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#HIERARCHY_WRONG_DOCTYPE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Document::ManakaiDOMDocument', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => 'newChild', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#node' => $newChild; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
;} |
|
|
|
|
|
; |
|
506 |
} |
} |
|
$anode = $anode-> |
|
|
next_sibling |
|
|
; |
|
507 |
} |
} |
|
} # has_el |
|
|
if ($has_dt) { |
|
|
my $anode = $refChild ? $refChild-> |
|
|
previous_sibling |
|
|
: |
|
|
$self-> |
|
|
last_child |
|
|
; |
|
|
while (defined $anode) { |
|
|
my $ant = $anode-> |
|
|
node_type |
|
|
; |
|
|
if ($ant == |
|
|
'1' |
|
|
) { |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth - 1; |
|
508 |
|
|
509 |
{ |
## ISSUE: This code is wrong. Old manakai's implementation |
510 |
|
## is better, but it is also wrong in some edge cases. |
511 |
report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'HIERARCHY_REQUEST_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'insert_before', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#HIERARCHY_WRONG_DOCTYPE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Document::ManakaiDOMDocument', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => 'newChild', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#node' => $newChild; |
## Maybe we should remove these code entirely. DOM3Core |
512 |
|
## conformance is not important for this bit. It only makes |
513 |
|
## things too complex. Same for replace_child's code. |
514 |
} |
if ($has_el) { |
515 |
|
my $anode = $self->last_child; |
516 |
|
while (defined $anode) { |
517 |
;} |
if ($anode->node_type == 1) { # ELEMENT_NODE |
518 |
|
report Message::DOM::DOMException |
519 |
; |
-object => $self, |
520 |
} elsif ($ant == |
-type => 'HIERARCHY_REQUEST_ERR', |
521 |
'10' |
-subtype => 'CHILD_NODE_TYPE_ERR'; |
522 |
) { |
} |
523 |
|
$anode = $anode->previous_sibling; |
|
|
|
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth - 1; |
|
|
|
|
|
{ |
|
|
|
|
|
report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'HIERARCHY_REQUEST_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'insert_before', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#MDOM_SECOND_DOCTYPE', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Document::ManakaiDOMDocument', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => 'newChild', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#node' => $newChild; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
;} |
|
|
|
|
|
; |
|
524 |
} |
} |
525 |
$anode = $anode-> |
} # has_el |
526 |
previous_sibling |
if ($has_dt) { |
527 |
; |
my $anode = $self->last_child; |
528 |
} |
while (defined $anode) { |
529 |
$anode = $refChild; |
my $ant = $anode->node_type; |
530 |
while (defined $anode) { |
if ($ant == 1 or $ant == 10) { # ELEMENT_NODE or DOCUMENT_TYPE_NODE |
531 |
if ($anode-> |
report Message::DOM::DOMException |
532 |
node_type |
-object => $self, |
533 |
|
-type => 'HIERARCHY_REQUEST_ERR', |
534 |
== |
-subtype => 'CHILD_NODE_TYPE_ERR'; |
535 |
'10' |
} |
536 |
) { |
$anode = $anode->previous_sibling; |
|
|
|
|
|
|
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth - 1; |
|
|
|
|
|
{ |
|
|
|
|
|
report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'HIERARCHY_REQUEST_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'insert_before', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#MDOM_SECOND_DOCTYPE', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Document::ManakaiDOMDocument', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => 'newChild', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#node' => $newChild; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
;} |
|
|
|
|
|
; |
|
537 |
} |
} |
538 |
$anode = $anode-> |
} # has_dt |
539 |
next_sibling |
} |
|
; |
|
|
} |
|
|
} # has_dt |
|
|
|
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
;} |
|
|
|
|
|
; |
|
|
} |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth + 1; |
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
my |
|
|
$strict = $self-> |
|
|
strict_error_checking |
|
|
; |
|
540 |
|
|
541 |
## -- Node Type check |
for my $cn (@new_child) { |
|
my @new_child; |
|
|
if ({ |
|
|
'3' => (not $strictc), |
|
|
'5' => (not $strictc), |
|
|
'1' => 1, |
|
|
'4' => (not $strictc), |
|
|
'7' => 1, |
|
|
'8' => 1, |
|
|
'10' => 1, |
|
|
}->{$child_nt}) { |
|
|
push @new_child, $newChild; |
|
|
} elsif ($child_nt == |
|
|
'11' |
|
|
) { |
|
|
for my $cn (@{$newChild-> |
|
|
child_nodes |
|
|
}) { |
|
542 |
unless ({ |
unless ({ |
543 |
'3' => (not $strictc), |
3, (not $strict_children), # TEXT_NODE |
544 |
'5' => (not $strictc), |
5, (not $strict_children), # ENTITY_REFERENCE_NODE |
545 |
'1' => 1, |
1, 1, # ELEMENT_NODE |
546 |
'4' => (not $strictc), |
4, (not $strict_children), # CDATA_SECTION_NODE |
547 |
'7' => 1, |
7, 1, # PROCESSING_INSTRUCTION_NODE |
548 |
'8' => 1, |
8, 1, # COMMENT_NODE |
549 |
'10' => 1, |
10, 1, # DOCUMENT_TYPE_NODE |
550 |
}->{$cn-> |
}->{$cn->node_type}) { |
551 |
node_type |
report Message::DOM::DOMException |
552 |
}) { |
-object => $self, |
553 |
|
-type => 'HIERARCHY_REQUEST_ERR', |
554 |
|
-subtype => 'CHILD_NODE_TYPE_ERR'; |
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth - 1; |
|
|
|
|
|
{ |
|
|
|
|
|
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; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
;} |
|
|
|
|
|
; |
|
555 |
} |
} |
|
push @new_child, $cn; |
|
|
} |
|
|
} else { |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth - 1; |
|
|
|
|
|
{ |
|
|
|
|
|
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; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
;} |
|
|
|
|
|
; |
|
|
} |
|
|
|
|
|
my $nc_parent = @new_child ? $new_child[0]-> |
|
|
parent_node |
|
|
: |
|
|
|
|
|
undef |
|
|
; |
|
|
if ($strict) { |
|
|
## -- Wrong-document check |
|
|
unless ($self eq $child_od) { |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth - 1; |
|
|
|
|
|
{ |
|
|
|
|
|
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; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
;} |
|
|
|
|
|
; |
|
|
} |
|
|
|
|
|
## -- Read-onlyness check |
|
|
if ($self-> |
|
|
manakai_read_only |
|
|
) { |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth - 1; |
|
|
|
|
|
{ |
|
|
|
|
|
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'; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
;} |
|
|
|
|
|
; |
|
556 |
} |
} |
|
if (@new_child) { |
|
|
if ($nc_parent and |
|
|
$nc_parent-> |
|
|
manakai_read_only |
|
|
) { |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth - 1; |
|
|
|
|
|
{ |
|
|
|
|
|
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'; |
|
557 |
|
|
558 |
|
## NOTE: Ancestor check here in |Node|. |
|
} |
|
|
|
|
|
|
|
|
;} |
|
|
|
|
|
; |
|
|
} |
|
|
} |
|
559 |
} |
} |
|
|
|
|
## -- Insert at... |
|
|
my $index = -1; # last |
|
560 |
|
|
561 |
|
## -- Insert at... ## NOTE: Only in insert_before and replace_child |
562 |
{ |
my $index = -1; # last |
563 |
|
if (defined $_[2]) { |
564 |
|
## error if $_[1] eq $_[2]; |
565 |
# tc:ForAppendChild & tc:ForReplaceChild |
|
566 |
if (defined $refChild) { |
my $cns = $self->child_nodes; |
567 |
if ($refChild eq $newChild) { |
my $cnsl = @$cns; |
568 |
|
C: { |
569 |
|
$index = 0; |
570 |
{ |
for my $i (0..($cnsl-1)) { |
571 |
|
my $cn = $cns->[$i]; |
572 |
|
if ($cn eq $_[2]) { |
573 |
{ |
$index += $i; |
574 |
|
last C; |
575 |
local $Error::Depth = $Error::Depth - 1; |
} elsif ($cn eq $_[1]) { |
576 |
|
$index = -1; # offset |
|
{ |
|
|
|
|
|
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'; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
;} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
; |
|
|
} |
|
|
|
|
|
my $cns = $self-> |
|
|
child_nodes |
|
|
; |
|
|
my $cnsl = @$cns; |
|
|
C: { |
|
|
$index = 0; |
|
|
for my $i (0..($cnsl-1)) { |
|
|
my $cn = $cns->[$i]; |
|
|
if ($cn eq $refChild) { |
|
|
$index += $i; |
|
|
last C; |
|
|
} elsif ($cn eq $newChild) { |
|
|
$index = -1; # offset |
|
|
} |
|
577 |
} |
} |
578 |
|
} |
|
|
|
|
{ |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth - 1; |
|
|
|
|
|
{ |
|
|
|
|
|
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; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
;} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
; |
|
|
} # C |
|
|
} else { # |oldChild| is not defined |
|
579 |
|
|
580 |
|
report Message::DOM::DOMException |
581 |
; |
-object => $self, |
582 |
} |
-type => 'NOT_FOUND_ERR', |
583 |
|
-subtype => 'NOT_CHILD_ERR'; |
584 |
|
} # C |
585 |
|
} |
586 |
} |
## NOTE: "else" only in replace_child |
|
|
|
|
; # FOR !tc:ForAppendChild |
|
587 |
|
|
588 |
## -- Removes from parent |
## -- Removes from parent |
589 |
if ($nc_parent) { |
if ($new_child_parent) { |
590 |
if ($child_nt == |
if (@new_child == 1) { |
591 |
'11' |
my $v = $$new_child_parent->{child_nodes}; |
|
) { |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$newChild->{ |
|
|
'b' |
|
|
}->{${$newChild->{ |
|
|
'id' |
|
|
}}} |
|
|
->{'child'} = []; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
} else { |
|
|
my $v; |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$v = $nc_parent->{ |
|
|
'b' |
|
|
}->{${$nc_parent->{ |
|
|
'id' |
|
|
}}} |
|
|
->{'child'}; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
592 |
RP: for my $i (0..$#$v) { |
RP: for my $i (0..$#$v) { |
593 |
my $nodeid = $v->[$i]; |
if ($v->[$i] eq $new_child[0]) { |
|
if ( |
|
|
(${$new_child[0]->{'id'}} eq ${$nodeid}) |
|
|
) { |
|
594 |
splice @$v, $i, 1, (); |
splice @$v, $i, 1, (); |
595 |
last RP; |
last RP; |
596 |
} |
} |
597 |
} # RP |
} # RP |
598 |
|
} else { |
599 |
|
@{$$new_child_parent->{child_nodes}} = (); |
600 |
} |
} |
601 |
} |
} |
602 |
|
|
603 |
## -- Rewrite the |parentNode| properties |
## -- Rewrite the |parentNode| properties |
604 |
for my $nc (@new_child) { |
for my $nc (@new_child) { |
605 |
|
$$nc->{parent_node} = $self; |
606 |
|
Scalar::Util::weaken ($$nc->{parent_node}); |
|
{ |
|
|
|
|
|
|
|
|
$nc->{ |
|
|
'b' |
|
|
}->{${$nc->{ |
|
|
'id' |
|
|
}}} |
|
|
->{'parent'} = $self->{ |
|
|
'id' |
|
|
}; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
607 |
} |
} |
608 |
|
|
609 |
my $children; |
## NOTE: Depends on method: |
610 |
|
if ($index == -1) { |
611 |
|
push @{$$self->{child_nodes}}, @new_child; |
612 |
{ |
} else { |
613 |
|
splice @{$$self->{child_nodes}}, $index, 0, @new_child; |
614 |
|
} |
|
$children = $self->{ |
|
|
'b' |
|
|
}->{${$self->{ |
|
|
'id' |
|
|
}}} |
|
|
->{'child'}; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
## -- Adds to children list |
|
|
if ($index == -1) { |
|
|
push @$children, map { |
|
|
|
|
|
$_->{'id'} |
|
|
|
|
|
} @new_child; |
|
|
} else { |
|
|
splice @$children, $index, 0, map { |
|
|
|
|
|
$_->{'id'} |
|
|
|
|
|
} @new_child; |
|
|
} |
|
|
$r = $newChild; |
|
|
|
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
;} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
if ($child_nt == |
|
|
'10' and |
|
|
|
|
|
not defined $newChild-> |
|
|
owner_document |
|
|
) { |
|
|
my $bag = |
|
|
$self->{'b'} |
|
|
; |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
CORE::delete |
|
|
$bag->{${$bag->{${$newChild->{ |
|
|
'id' |
|
|
}}} |
|
|
->{'impl'} or \''}} |
|
|
->{'lpmi'}; |
|
|
$bag->{ |
|
|
'm' |
|
|
}++; |
|
|
CORE::delete $bag->{${$newChild->{ |
|
|
'id' |
|
|
}}} |
|
|
->{'impl'}; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$bag->{${$newChild->{ |
|
|
'id' |
|
|
}}}->{'od'} |
|
|
= $self->{ |
|
|
'id' |
|
|
}; |
|
|
$bag->{${$self->{ |
|
|
'id' |
|
|
}}} |
|
|
->{'do'}->{${$newChild->{ |
|
|
'id' |
|
|
}}} |
|
|
= $newChild->{ |
|
|
'id' |
|
|
}; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
} |
|
|
|
|
|
|
|
|
} |
|
|
$r} |
|
|
sub replace_child ($$$) { |
|
|
my ($self, $newChild, $oldChild) = @_; |
|
|
my $r; |
|
|
|
|
|
{ |
|
|
|
|
|
my |
|
|
$strictc = $self-> |
|
|
dom_config |
|
|
|
|
|
-> |
|
|
get_parameter |
|
|
|
|
|
( |
|
|
'http://suika.fam.cx/www/2006/dom-config/strict-document-children' |
|
|
); |
|
|
my $child_od = $newChild-> |
|
|
owner_document |
|
|
|| $self; |
|
|
my $child_nt = $newChild-> |
|
|
node_type |
|
|
; |
|
|
if ($strictc and $self-> |
|
|
strict_error_checking |
|
|
) { |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth + 1; |
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
my |
|
|
$has_el; |
|
|
my $has_dt; |
|
|
if ($child_nt == |
|
|
'1' |
|
|
) { |
|
|
$has_el = |
|
|
1 |
|
|
; |
|
|
} elsif ($child_nt == |
|
|
'10' |
|
|
) { |
|
|
$has_dt = |
|
|
1 |
|
|
; |
|
|
} elsif ($child_nt == |
|
|
'11' |
|
|
) { |
|
|
for my $cn (@{$newChild-> |
|
|
child_nodes |
|
|
}) { |
|
|
my $cnt = $cn-> |
|
|
node_type |
|
|
; |
|
|
if ($cnt == |
|
|
'1' |
|
|
) { |
|
|
if ($has_el) { |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth - 1; |
|
|
|
|
|
{ |
|
|
|
|
|
report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'HIERARCHY_REQUEST_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'replace_child', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#MDOM_SECOND_DOC_ELEMENT', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Document::ManakaiDOMDocument', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => 'newChild', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#node' => $newChild; |
|
615 |
|
|
616 |
|
## NOTE: Only in |Document|. |
617 |
|
for (@new_child) { |
618 |
|
delete $$_->{implementation}; |
619 |
|
$$_->{owner_document} = $self; |
620 |
|
Scalar::Util::weaken ($$_->{owner_document}); |
621 |
|
} |
622 |
|
|
623 |
} |
return $_[1]; |
624 |
|
} # insert_before |
625 |
|
|
626 |
|
sub replace_child ($$) { |
627 |
|
## NOTE: Overrides |Node|'s implementation. |
628 |
|
my $self = $_[0]; |
629 |
|
|
630 |
;} |
## NOTE: |$self_od| code here depending on $self->node_type. |
631 |
|
|
632 |
; |
## -- Node Type check |
633 |
|
my @new_child; |
634 |
|
my $new_child_parent; |
635 |
|
if ($_[1]->node_type == 11) { # DOCUMENT_FRAGMENT_NODE |
636 |
|
push @new_child, @{$_[1]->child_nodes}; |
637 |
|
$new_child_parent = $_[1]; |
638 |
|
} else { |
639 |
|
@new_child = ($_[1]); |
640 |
|
$new_child_parent = $_[1]->parent_node; |
641 |
|
} |
642 |
|
|
643 |
|
## NOTE: Depends on $self->node_type: |
644 |
|
if ($$self->{strict_error_checking}) { |
645 |
|
my $child_od = $_[1]->owner_document || $_[1]; # might be DocumentType |
646 |
|
if ($self ne $child_od and $child_od->node_type != 10) { |
647 |
|
report Message::DOM::DOMException # DOCUMENT_TYPE_NODE |
648 |
|
-object => $self, |
649 |
|
-type => 'WRONG_DOCUMENT_ERR', |
650 |
|
-subtype => 'EXTERNAL_OBJECT_ERR'; |
651 |
|
} |
652 |
|
|
653 |
|
if ($$self->{manakai_read_only} or |
654 |
|
(@new_child and defined $new_child_parent and |
655 |
|
$$new_child_parent->{manakai_read_only})) { |
656 |
|
report Message::DOM::DOMException |
657 |
|
-object => $self, |
658 |
|
-type => 'NO_MODIFICATION_ALLOWED_ERR', |
659 |
|
-subtype => 'READ_ONLY_NODE_ERR'; |
660 |
|
} |
661 |
|
|
662 |
|
## NOTE: Only in |Document|: |
663 |
|
my $strict_children = $self->dom_config->get_parameter |
664 |
|
(q<http://suika.fam.cx/www/2006/dom-config/strict-document-children>); |
665 |
|
if ($strict_children) { |
666 |
|
my $has_el; |
667 |
|
my $has_dt; |
668 |
|
my $child_nt = $_[1]->node_type; |
669 |
|
if ($child_nt == 1) { # ELEMENT_NODE |
670 |
|
$has_el = 1; |
671 |
|
} elsif ($child_nt == 10) { # DOCUMENT_TYPE_NODE |
672 |
|
$has_dt = 1; |
673 |
|
} elsif ($child_nt == 11) { # DOCUMENT_FRAGMENT_NODE |
674 |
|
for my $cn (@{$_[1]->child_nodes}) { |
675 |
|
my $cnt = $cn->node_type; |
676 |
|
if ($cnt == 1) { # ELEMENT_NODE |
677 |
|
if ($has_el) { |
678 |
|
report Message::DOM::DOMException |
679 |
|
-object => $self, |
680 |
|
-type => 'HIERARCHY_REQUEST_ERR', |
681 |
|
-subtype => 'CHILD_NODE_TYPE_ERR'; |
682 |
|
} |
683 |
|
$has_el = 1; |
684 |
|
} elsif ($cnt == 10) { # DOCUMENT_TYPE_NODE |
685 |
|
## NOTE: |DocumentType| node cannot be contained in |
686 |
|
## |DocumentFragment| in strict mode. |
687 |
|
if ($has_dt) { |
688 |
|
report Message::DOM::DOMException |
689 |
|
-object => $self, |
690 |
|
-type => 'HIERARCHY_REQUEST_ERR', |
691 |
|
-subtype => 'CHILD_NODE_TYPE_ERR'; |
692 |
|
} |
693 |
|
$has_dt = 1; |
694 |
} |
} |
|
$has_el = |
|
|
1 |
|
|
; |
|
|
} |
|
|
# DocumentType node cannot be contained in DocumentFragments |
|
|
} |
|
|
} |
|
|
|
|
|
if ($has_el) { |
|
|
my $anode = $oldChild-> |
|
|
previous_sibling |
|
|
; |
|
|
while (defined $anode) { |
|
|
if ($anode-> |
|
|
node_type |
|
|
== |
|
|
'1' |
|
|
) { |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth - 1; |
|
|
|
|
|
{ |
|
|
|
|
|
report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'HIERARCHY_REQUEST_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'replace_child', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#MDOM_SECOND_DOC_ELEMENT', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Document::ManakaiDOMDocument', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => 'newChild', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#node' => $newChild; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
;} |
|
|
|
|
|
; |
|
695 |
} |
} |
|
$anode = $anode-> |
|
|
previous_sibling |
|
|
; |
|
696 |
} |
} |
697 |
$anode = $oldChild-> |
|
698 |
next_sibling |
if ($has_el) { |
699 |
; |
my $anode = $self->last_child; |
700 |
while (defined $anode) { |
while (defined $anode) { |
701 |
my $ant = $anode-> |
if ($anode->node_type == 1) { # ELEMENT_NODE |
702 |
node_type |
report Message::DOM::DOMException |
703 |
; |
-object => $self, |
704 |
if ($ant == |
-type => 'HIERARCHY_REQUEST_ERR', |
705 |
'1' |
-subtype => 'CHILD_NODE_TYPE_ERR'; |
706 |
) { |
} |
707 |
|
$anode = $anode->previous_sibling; |
|
|
|
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth - 1; |
|
|
|
|
|
{ |
|
|
|
|
|
report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'HIERARCHY_REQUEST_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'replace_child', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#MDOM_SECOND_DOC_ELEMENT', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Document::ManakaiDOMDocument', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => 'newChild', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#node' => $newChild; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
;} |
|
|
|
|
|
; |
|
|
} elsif ($ant == |
|
|
'10' |
|
|
) { |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth - 1; |
|
|
|
|
|
{ |
|
|
|
|
|
report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'HIERARCHY_REQUEST_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'replace_child', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#HIERARCHY_WRONG_DOCTYPE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Document::ManakaiDOMDocument', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => 'newChild', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#node' => $newChild; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
;} |
|
|
|
|
|
; |
|
|
} |
|
|
$anode = $anode-> |
|
|
next_sibling |
|
|
; |
|
|
} |
|
|
} # has_el |
|
|
if ($has_dt) { |
|
|
my $anode = $oldChild-> |
|
|
previous_sibling |
|
|
; |
|
|
while (defined $anode) { |
|
|
my $ant = $anode-> |
|
|
node_type |
|
|
; |
|
|
if ($ant == |
|
|
'1' |
|
|
) { |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth - 1; |
|
|
|
|
|
{ |
|
|
|
|
|
report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'HIERARCHY_REQUEST_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'replace_child', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#HIERARCHY_WRONG_DOCTYPE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Document::ManakaiDOMDocument', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => 'newChild', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#node' => $newChild; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
;} |
|
|
|
|
|
; |
|
|
} elsif ($ant == |
|
|
'10' |
|
|
) { |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth - 1; |
|
|
|
|
|
{ |
|
|
|
|
|
report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'HIERARCHY_REQUEST_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'replace_child', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#MDOM_SECOND_DOCTYPE', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Document::ManakaiDOMDocument', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => 'newChild', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#node' => $newChild; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
;} |
|
|
|
|
|
; |
|
708 |
} |
} |
709 |
$anode = $anode-> |
} # has_el |
710 |
previous_sibling |
if ($has_dt) { |
711 |
; |
my $anode = $self->last_child; |
712 |
} |
while (defined $anode) { |
713 |
$anode = $oldChild-> |
my $ant = $anode->node_type; |
714 |
next_sibling |
if ($ant == 1 or $ant == 10) { # ELEMENT_NODE or DOCUMENT_TYPE_NODE |
715 |
; |
report Message::DOM::DOMException |
716 |
while (defined $anode) { |
-object => $self, |
717 |
if ($anode-> |
-type => 'HIERARCHY_REQUEST_ERR', |
718 |
node_type |
-subtype => 'CHILD_NODE_TYPE_ERR'; |
719 |
|
} |
720 |
== |
$anode = $anode->previous_sibling; |
|
'10' |
|
|
) { |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth - 1; |
|
|
|
|
|
{ |
|
|
|
|
|
report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'HIERARCHY_REQUEST_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'replace_child', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#MDOM_SECOND_DOCTYPE', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Document::ManakaiDOMDocument', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => 'newChild', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#node' => $newChild; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
;} |
|
|
|
|
|
; |
|
721 |
} |
} |
722 |
$anode = $anode-> |
} # has_dt |
723 |
next_sibling |
} |
|
; |
|
|
} |
|
|
} # has_dt |
|
|
|
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
;} |
|
|
|
|
|
; |
|
|
} |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth + 1; |
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
my |
|
|
$strict = $self-> |
|
|
strict_error_checking |
|
|
; |
|
724 |
|
|
725 |
## -- Node Type check |
for my $cn (@new_child) { |
|
my @new_child; |
|
|
if ({ |
|
|
'3' => (not $strictc), |
|
|
'5' => (not $strictc), |
|
|
'1' => 1, |
|
|
'4' => (not $strictc), |
|
|
'7' => 1, |
|
|
'8' => 1, |
|
|
'10' => 1, |
|
|
}->{$child_nt}) { |
|
|
push @new_child, $newChild; |
|
|
} elsif ($child_nt == |
|
|
'11' |
|
|
) { |
|
|
for my $cn (@{$newChild-> |
|
|
child_nodes |
|
|
}) { |
|
726 |
unless ({ |
unless ({ |
727 |
'3' => (not $strictc), |
3, (not $strict_children), # TEXT_NODE |
728 |
'5' => (not $strictc), |
5, (not $strict_children), # ENTITY_REFERENCE_NODE |
729 |
'1' => 1, |
1, 1, # ELEMENT_NODE |
730 |
'4' => (not $strictc), |
4, (not $strict_children), # CDATA_SECTION_NODE |
731 |
'7' => 1, |
7, 1, # PROCESSING_INSTRUCTION_NODE |
732 |
'8' => 1, |
8, 1, # COMMENT_NODE |
733 |
'10' => 1, |
10, 1, # DOCUMENT_TYPE_NODE |
734 |
}->{$cn-> |
}->{$cn->node_type}) { |
735 |
node_type |
report Message::DOM::DOMException |
736 |
}) { |
-object => $self, |
737 |
|
-type => 'HIERARCHY_REQUEST_ERR', |
738 |
|
-subtype => 'CHILD_NODE_TYPE_ERR'; |
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth - 1; |
|
|
|
|
|
{ |
|
|
|
|
|
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; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
;} |
|
|
|
|
|
; |
|
739 |
} |
} |
|
push @new_child, $cn; |
|
740 |
} |
} |
|
} else { |
|
|
|
|
741 |
|
|
742 |
{ |
## NOTE: Ancestor check here in |Node|. |
|
|
|
|
local $Error::Depth = $Error::Depth - 1; |
|
|
|
|
|
{ |
|
|
|
|
|
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; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
;} |
|
|
|
|
|
; |
|
743 |
} |
} |
|
|
|
|
my $nc_parent = @new_child ? $new_child[0]-> |
|
|
parent_node |
|
|
: |
|
|
|
|
|
undef |
|
|
; |
|
|
if ($strict) { |
|
|
## -- Wrong-document check |
|
|
unless ($self eq $child_od) { |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth - 1; |
|
|
|
|
|
{ |
|
|
|
|
|
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; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
;} |
|
|
|
|
|
; |
|
|
} |
|
|
|
|
|
## -- Read-onlyness check |
|
|
if ($self-> |
|
|
manakai_read_only |
|
|
) { |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth - 1; |
|
|
|
|
|
{ |
|
|
|
|
|
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'; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
;} |
|
|
|
|
|
; |
|
|
} |
|
|
if (@new_child) { |
|
|
if ($nc_parent and |
|
|
$nc_parent-> |
|
|
manakai_read_only |
|
|
) { |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth - 1; |
|
|
|
|
|
{ |
|
|
|
|
|
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'; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
;} |
|
|
|
|
|
; |
|
|
} |
|
|
} |
|
|
} |
|
|
|
|
|
## -- Insert at... |
|
|
my $index = -1; # last |
|
744 |
|
|
745 |
|
## -- Insert at... ## NOTE: Only in insertBefore and replaceChild |
746 |
{ |
my $index = -1; # last |
747 |
|
if (defined $_[2]) { |
748 |
|
## error if $_[1] eq $_[2]; |
749 |
# tc:ForAppendChild & tc:ForReplaceChild |
|
750 |
if (defined $oldChild) { |
my $cns = $self->child_nodes; |
751 |
if ($oldChild eq $newChild) { |
my $cnsl = @$cns; |
752 |
|
C: { |
753 |
|
$index = 0; |
754 |
; |
for my $i (0..($cnsl-1)) { |
755 |
|
my $cn = $cns->[$i]; |
756 |
|
if ($cn eq $_[2]) { |
757 |
{ |
$index += $i; |
758 |
|
last C; |
759 |
|
} elsif ($cn eq $_[1]) { |
760 |
{ |
$index = -1; # offset |
|
|
|
|
local $Error::Depth = $Error::Depth - 1; |
|
|
|
|
|
{ |
|
|
|
|
|
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'; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
;} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
} |
|
|
|
|
|
my $cns = $self-> |
|
|
child_nodes |
|
|
; |
|
|
my $cnsl = @$cns; |
|
|
C: { |
|
|
$index = 0; |
|
|
for my $i (0..($cnsl-1)) { |
|
|
my $cn = $cns->[$i]; |
|
|
if ($cn eq $oldChild) { |
|
|
$index += $i; |
|
|
last C; |
|
|
} elsif ($cn eq $newChild) { |
|
|
$index = -1; # offset |
|
|
} |
|
761 |
} |
} |
762 |
|
} |
|
|
|
|
; |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth - 1; |
|
|
|
|
|
{ |
|
|
|
|
|
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; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
;} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
} # C |
|
|
} else { # |oldChild| is not defined |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth - 1; |
|
|
|
|
|
{ |
|
|
|
|
|
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; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
;} |
|
|
|
|
|
; |
|
763 |
|
|
764 |
|
report Message::DOM::DOMException |
765 |
|
-object => $self, |
766 |
} |
-type => 'NOT_FOUND_ERR', |
767 |
|
-subtype => 'NOT_CHILD_ERR'; |
768 |
; |
} # C |
769 |
} |
} else { |
770 |
|
## NOTE: Only in replaceChild |
771 |
|
report Message::DOM::DOMException |
772 |
|
-object => $self, |
773 |
} |
-type => 'NOT_FOUND_ERR', |
774 |
|
-subtype => 'NOT_CHILD_ERR'; |
775 |
; # FOR !tc:ForAppendChild |
} |
776 |
|
|
777 |
## -- Removes from parent |
## -- Removes from parent |
778 |
if ($nc_parent) { |
if ($new_child_parent) { |
779 |
if ($child_nt == |
if (@new_child == 1) { |
780 |
'11' |
my $v = $$new_child_parent->{child_nodes}; |
|
) { |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$newChild->{ |
|
|
'b' |
|
|
}->{${$newChild->{ |
|
|
'id' |
|
|
}}} |
|
|
->{'child'} = []; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
} else { |
|
|
my $v; |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$v = $nc_parent->{ |
|
|
'b' |
|
|
}->{${$nc_parent->{ |
|
|
'id' |
|
|
}}} |
|
|
->{'child'}; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
781 |
RP: for my $i (0..$#$v) { |
RP: for my $i (0..$#$v) { |
782 |
my $nodeid = $v->[$i]; |
if ($v->[$i] eq $new_child[0]) { |
|
if ( |
|
|
(${$new_child[0]->{'id'}} eq ${$nodeid}) |
|
|
) { |
|
783 |
splice @$v, $i, 1, (); |
splice @$v, $i, 1, (); |
784 |
last RP; |
last RP; |
785 |
} |
} |
786 |
} # RP |
} # RP |
787 |
|
} else { |
788 |
|
@{$$new_child_parent->{child_nodes}} = (); |
789 |
} |
} |
790 |
} |
} |
791 |
|
|
792 |
## -- Rewrite the |parentNode| properties |
## -- Rewrite the |parentNode| properties |
793 |
for my $nc (@new_child) { |
for my $nc (@new_child) { |
794 |
|
$$nc->{parent_node} = $self; |
795 |
|
Scalar::Util::weaken ($$nc->{parent_node}); |
|
{ |
|
|
|
|
|
|
|
|
$nc->{ |
|
|
'b' |
|
|
}->{${$nc->{ |
|
|
'id' |
|
|
}}} |
|
|
->{'parent'} = $self->{ |
|
|
'id' |
|
|
}; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
796 |
} |
} |
797 |
|
|
798 |
my $children; |
## NOTE: Depends on method: |
799 |
|
splice @{$$self->{child_nodes}}, $index, 1, @new_child; |
800 |
|
delete ${$_[2]}->{parent_node}; |
|
{ |
|
|
|
|
|
|
|
|
$children = $self->{ |
|
|
'b' |
|
|
}->{${$self->{ |
|
|
'id' |
|
|
}}} |
|
|
->{'child'}; |
|
801 |
|
|
802 |
|
## NOTE: Only in |Document|. |
803 |
} |
for (@new_child) { |
804 |
|
delete $$_->{implementation}; |
805 |
; |
$$_->{owner_document} = $self; |
806 |
|
Scalar::Util::weaken ($$_->{owner_document}); |
|
|
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
## -- Replaces the node |
|
|
splice @$children, $index, 1, map { |
|
|
|
|
|
$_->{'id'} |
|
|
|
|
|
} @new_child; |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
CORE::delete |
|
|
$oldChild->{ |
|
|
'b' |
|
|
}->{${$oldChild->{ |
|
|
'id' |
|
|
}}} |
|
|
->{'parent'}; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
$r = $oldChild; |
|
|
|
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
;} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
if ($child_nt == |
|
|
'10' and |
|
|
|
|
|
not defined $newChild-> |
|
|
owner_document |
|
|
) { |
|
|
my $bag = |
|
|
$self->{'b'} |
|
|
; |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
CORE::delete |
|
|
$bag->{${$bag->{${$newChild->{ |
|
|
'id' |
|
|
}}} |
|
|
->{'impl'} or \''}} |
|
|
->{'lpmi'}; |
|
|
$bag->{ |
|
|
'm' |
|
|
}++; |
|
|
CORE::delete $bag->{${$newChild->{ |
|
|
'id' |
|
|
}}} |
|
|
->{'impl'}; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$bag->{${$newChild->{ |
|
|
'id' |
|
|
}}}->{'od'} |
|
|
= $self->{ |
|
|
'id' |
|
|
}; |
|
|
$bag->{${$self->{ |
|
|
'id' |
|
|
}}} |
|
|
->{'do'}->{${$newChild->{ |
|
|
'id' |
|
|
}}} |
|
|
= $newChild->{ |
|
|
'id' |
|
|
}; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
} |
|
|
|
|
|
|
|
|
} |
|
|
$r} |
|
|
sub manakai_append_text ($$) { |
|
|
my ($self, $string) = @_; |
|
|
my $r; |
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth + 1; |
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
unless |
|
|
($self-> |
|
|
dom_config |
|
|
|
|
|
-> |
|
|
get_parameter |
|
|
|
|
|
( |
|
|
'http://suika.fam.cx/www/2006/dom-config/strict-document-children' |
|
|
)) { |
|
|
my $lc = $self-> |
|
|
last_child |
|
|
; |
|
|
if (defined $lc and |
|
|
$lc-> |
|
|
node_type |
|
|
== |
|
|
'3' |
|
|
) { |
|
|
$lc-> |
|
|
manakai_append_text |
|
|
|
|
|
(ref $string eq 'SCALAR' ? $string : \$string); |
|
|
} else { |
|
|
my $text = $self-> |
|
|
create_text_node |
|
|
|
|
|
(ref $string eq 'SCALAR' ? $$string : $string); |
|
|
$self-> |
|
|
append_child |
|
|
($text); |
|
|
} |
|
807 |
} |
} |
|
$r = $self; |
|
|
|
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
;} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
} |
|
|
$r} |
|
|
sub remove_child ($$) { |
|
|
my ($self, $oldChild) = @_; |
|
|
my $r; |
|
|
|
|
|
{ |
|
|
|
|
|
if |
|
|
($self-> |
|
|
strict_error_checking and |
|
|
|
|
|
$self-> |
|
|
manakai_read_only |
|
|
) { |
|
|
|
|
|
report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'remove_child', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#NOMOD_THIS', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Document::ManakaiDOMDocument'; |
|
|
|
|
|
; |
|
|
} |
|
|
|
|
808 |
|
|
809 |
{ |
return $_[2]; |
810 |
|
} # replace_child |
|
F: |
|
|
{ |
|
|
my $i = -1; |
|
|
for my $cld (@{$self-> |
|
|
child_nodes |
|
|
}) { |
|
|
$i++; |
|
|
if ($cld eq $oldChild) { |
|
|
my $v; |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$v = $self->{ |
|
|
'b' |
|
|
}->{${$self->{ |
|
|
'id' |
|
|
}}} |
|
|
->{'child'}; |
|
811 |
|
|
812 |
|
## |Document| attributes |
813 |
|
|
814 |
} |
## NOTE: A manakai extension. |
815 |
|
sub all_declarations_processed ($;$); |
816 |
|
|
817 |
; |
sub doctype ($) { |
818 |
splice @$v, $i, 1, (); |
my $self = $_[0]; |
819 |
|
for (@{$self->child_nodes}) { |
820 |
|
if ($_->node_type == 10) { # DOCUMENT_TYPE_NODE |
821 |
{ |
return $_; |
|
|
|
|
CORE::delete |
|
|
$oldChild->{ |
|
|
'b' |
|
|
}->{${$oldChild->{ |
|
|
'id' |
|
|
}}} |
|
|
->{'parent'}; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
$r = $oldChild; |
|
|
last F; |
|
822 |
} |
} |
823 |
} |
} |
824 |
|
return undef; |
825 |
report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NOT_FOUND_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#NOT_CHILD_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/removeChildImpl+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => 'oldChild', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#node' => $oldChild; |
} # doctype |
|
|
|
|
; |
|
|
} # F |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
} |
|
|
$r} |
|
|
sub node_name ($;$) { |
|
|
if (@_ == 1) {my ($self) = @_; |
|
|
my $r = ''; |
|
|
$r = '#document'; |
|
|
$r; |
|
|
} else {my ($self) = @_; |
|
|
report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Document::ManakaiDOMDocument', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'node_name'; |
|
|
} |
|
|
} |
|
|
sub text_content ($;$) { |
|
|
if (@_ == 1) {my ($self) = @_; |
|
|
my $r = ''; |
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth + 1; |
|
826 |
|
|
827 |
{ |
sub document_element ($) { |
828 |
|
my $self = shift; |
829 |
|
for (@{$self->child_nodes}) { |
830 |
if |
if ($_->node_type == 1) { # ELEMENT_NODE |
831 |
($self-> |
return $_; |
|
dom_config |
|
|
|
|
|
-> |
|
|
get_parameter |
|
|
|
|
|
( |
|
|
'http://suika.fam.cx/www/2006/dom-config/strict-document-children' |
|
|
)) { |
|
|
$r = |
|
|
undef |
|
|
; |
|
|
} else { |
|
|
$r = ''; |
|
|
my @target = @{$self-> |
|
|
child_nodes |
|
|
}; |
|
|
C: for my $node (@target) { |
|
|
my $nt = $node-> |
|
|
node_type |
|
|
; |
|
|
if ($nt == |
|
|
'3' or |
|
|
|
|
|
$nt == |
|
|
'4' |
|
|
) { |
|
|
$r .= $node-> |
|
|
data |
|
|
unless |
|
|
$node-> |
|
|
is_element_content_whitespace |
|
|
; |
|
|
} elsif ($nt == |
|
|
'1' or |
|
|
|
|
|
$nt == |
|
|
'5' |
|
|
) { |
|
|
unshift @target, @{$node-> |
|
|
child_nodes |
|
|
}; |
|
|
} |
|
832 |
} |
} |
833 |
} |
} |
834 |
|
return undef; |
835 |
|
} # document_element |
836 |
|
|
837 |
|
sub document_uri ($;$); |
838 |
|
|
839 |
|
sub dom_config ($) { |
840 |
|
require Message::DOM::DOMConfiguration; |
841 |
|
return bless \\($_[0]), 'Message::DOM::DOMConfiguration'; |
842 |
|
} # dom_config |
843 |
|
|
844 |
} |
sub manakai_entity_base_uri ($;$) { |
845 |
|
my $self = $_[0]; |
846 |
|
if (@_ > 1) { |
847 |
;} |
if ($$self->{strict_error_checking}) { |
848 |
|
if ($$self->{manakai_read_only}) { |
849 |
; |
report Message::DOM::DOMException |
850 |
|
-object => $self, |
851 |
|
-type => 'NO_MODIFICATION_ALLOWED_ERR', |
852 |
} |
-subtype => 'READ_ONLY_NODE_ERR'; |
853 |
$r; |
} |
|
} else {my ($self, $given) = @_; |
|
|
|
|
|
{ |
|
|
|
|
|
if |
|
|
($self-> |
|
|
dom_config |
|
|
|
|
|
-> |
|
|
get_parameter |
|
|
|
|
|
( |
|
|
'http://suika.fam.cx/www/2006/dom-config/strict-document-children' |
|
|
)) { |
|
|
|
|
|
report Message::DOM::DOMCore::ManakaiDOMError -object => $self, '-type' => 'http://suika.fam.cx/~wakaba/archive/2004/dom/tree#setting-node-value-no-effect', 'rdata' => $self, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'set', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Document::ManakaiDOMDocument', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'text_content'; |
|
|
|
|
|
; |
|
|
} else { |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
if |
|
|
($self-> |
|
|
manakai_read_only |
|
|
) { |
|
|
|
|
|
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'; |
|
|
|
|
|
; |
|
|
} |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
|
|
|
my @__old_children = @{$self-> |
|
|
child_nodes |
|
|
}; |
|
|
for my $__old_child (@__old_children) { |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
CORE::delete |
|
|
$__old_child->{ |
|
|
'b' |
|
|
}->{${$__old_child->{ |
|
|
'id' |
|
|
}}} |
|
|
->{'parent'}; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
} |
|
|
|
|
|
my @__new_children; |
|
|
if (defined $given and length $given) { |
|
|
my $__text = $self-> |
|
|
create_text_node |
|
|
($given); |
|
|
push @__new_children, |
|
|
$__text->{'id'} |
|
|
; |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$__text->{ |
|
|
'b' |
|
|
}->{${$__text->{ |
|
|
'id' |
|
|
}}} |
|
|
->{'parent'} = $self->{ |
|
|
'id' |
|
|
}; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$self->{ |
|
|
'b' |
|
|
}->{${$self->{ |
|
|
'id' |
|
|
}}} |
|
|
->{'child'} = \@__new_children; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
} |
|
|
|
|
|
|
|
|
} |
|
|
} |
|
|
} |
|
|
sub get_feature ($$$) { |
|
|
my ($self, $feature, $version) = @_; |
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$feature = lc $feature; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$version = '' unless defined $version; |
|
|
|
|
|
|
|
|
} |
|
|
my $r; |
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$feature =~ s/^\+//; |
|
|
|
|
|
## TODO: Remove this code and implement autoload |
|
|
if ($feature eq |
|
|
'http://suika.fam.cx/www/2006/feature/xdoctype' |
|
|
) { |
|
|
require Message::DOM::XDoctype; |
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
if |
|
|
($Message::DOM::DOMFeature::ClassInfo->{ref $self} |
|
|
->{has_feature}->{$feature}->{$version}) { |
|
|
$r = $self; |
|
|
} else { |
|
|
CLASS: for my $__class (sort { |
|
|
$Message::DOM::ClassPoint{$b} <=> $Message::DOM::ClassPoint{$a} |
|
|
} grep { |
|
|
$Message::DOM::DOMFeature::ClassInfo->{'Message::DOM::Document::ManakaiDOMDocument'} |
|
|
->{compat_class}->{$_} |
|
|
} keys %{$Message::DOM::DOMFeature::ClassInfo->{'Message::DOM::Document::ManakaiDOMDocument'} |
|
|
->{compat_class} or {}}) { |
|
|
if ($Message::DOM::DOMFeature::ClassInfo->{$__class} |
|
|
->{has_feature}->{$feature}->{$version}) { |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$r = ${($self->{'b'})->{${($self->{'id'})}}->{ |
|
|
'cls' |
|
|
}}->___create_node_ref ({ |
|
|
|
|
|
'id' |
|
|
=> ($self->{'id'}), |
|
|
|
|
|
'b' |
|
|
=> ($self->{'b'}), |
|
|
}, { |
|
|
'nrcls' => \$__class, |
|
|
}); |
|
|
($self->{'b'})->{${($self->{'id'})}}->{ |
|
|
'rc' |
|
|
}++; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
last CLASS; |
|
|
} |
|
|
} # CLASS |
|
|
} |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
unless (defined $r) { |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth + 1; |
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
|
|
|
$r = $self->SUPER::get_feature ($feature, $version); |
|
|
|
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
;} |
|
|
|
|
|
; |
|
|
} |
|
|
|
|
|
|
|
|
} |
|
|
$r} |
|
|
sub base_uri ($;$) { |
|
|
if (@_ == 1) {my ($self) = @_; |
|
|
my $r = ''; |
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$r = $self->{ |
|
|
'b' |
|
|
}->{${$self->{ |
|
|
'id' |
|
|
}}} |
|
|
->{'buri'}; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
unless (defined $r) { |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$r = $self->{ |
|
|
'b' |
|
|
}->{${$self->{ |
|
|
'id' |
|
|
}}} |
|
|
->{'duri'}; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
} |
|
|
|
|
|
|
|
|
} |
|
|
$r; |
|
|
} else {my ($self) = @_; |
|
|
report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Document::ManakaiDOMDocument', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'base_uri'; |
|
|
} |
|
|
} |
|
|
sub create_element ($$) { |
|
|
my ($self, $tagName) = @_; |
|
|
my $r; |
|
|
|
|
|
{ |
|
|
|
|
|
my |
|
|
$strict = $self-> |
|
|
strict_error_checking |
|
|
; |
|
|
if ($strict) { |
|
|
my $version = $self-> |
|
|
xml_version |
|
|
; |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
if |
|
|
(defined $tagName) { |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
if |
|
|
(((not defined $version or $version eq '1.0') and |
|
|
not |
|
|
($tagName =~ /\A\p{InXML_NameStartChar10}\p{InXMLNameChar10}*\z/) |
|
|
) or |
|
|
(defined $version and $version eq '1.1' and |
|
|
not |
|
|
($tagName =~ /\A\p{InXMLNameStartChar11}\p{InXMLNameChar11}*\z/) |
|
|
)) { |
|
|
|
|
|
report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'INVALID_CHARACTER_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#MDOM_BAD_NAME', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#name' => $tagName, 'http://www.w3.org/2001/04/infoset#version' => $version, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2004/dom/main%23ensureXMLName+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => '$INPUT_PARAM_NAME'; |
|
|
|
|
|
; |
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
; |
|
|
} |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
} |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth + 1; |
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
|
|
|
$self-> |
|
|
strict_error_checking |
|
|
( |
|
|
0 |
|
|
); |
|
|
$r = $self-> |
|
|
create_element_ns |
|
|
( |
|
|
undef |
|
|
, [ |
|
|
undef |
|
|
, $tagName]); |
|
|
$self-> |
|
|
strict_error_checking |
|
|
($strict); |
|
|
|
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
;} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
} |
|
|
$r} |
|
|
sub create_element_ns ($$$) { |
|
|
my ($self, $namespaceURI, $qualifiedName) = @_; |
|
|
|
|
|
{ |
|
|
|
|
|
if |
|
|
(CORE::defined $namespaceURI and CORE::length $namespaceURI == 0) { |
|
|
|
|
|
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:1144080824:30455:ZO0D78781+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest'; |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$namespaceURI = undef; |
|
|
|
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
} |
|
|
|
|
|
|
|
|
} |
|
|
my $r; |
|
|
|
|
|
{ |
|
|
|
|
|
require |
|
|
Message::DOM::Element; |
|
|
|
|
|
my ($prefix, $lname) = ref $qualifiedName eq 'ARRAY' |
|
|
? @$qualifiedName |
|
|
: split /:/, $qualifiedName, 2; |
|
|
($prefix, $lname) = ( |
|
|
undef |
|
|
, $prefix) unless defined $lname; |
|
|
$qualifiedName = defined $prefix ? $prefix.':'.$lname : $lname; |
|
|
|
|
|
if ($self-> |
|
|
strict_error_checking |
|
|
) { |
|
|
my $version = $self-> |
|
|
xml_version |
|
|
; |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
if |
|
|
(defined $version and $version eq '1.1') { |
|
|
unless ( |
|
|
($qualifiedName =~ /\A\p{InXMLNameStartChar11}\p{InXMLNameChar11}*\z/) |
|
|
) { |
|
|
|
|
|
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'; |
|
|
|
|
|
; |
|
|
} |
|
|
unless ( |
|
|
($qualifiedName =~ /\A\p{InXMLNCNameStartChar11}\p{InXMLNCNameChar11}*(?::\p{InXMLNCNameStartChar11}\p{InXMLNCNameChar11}*)?\z/) |
|
|
) { |
|
|
|
|
|
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'; |
|
|
|
|
|
; |
|
|
} |
|
|
} else { |
|
|
unless ( |
|
|
($qualifiedName =~ /\A\p{InXML_NameStartChar10}\p{InXMLNameChar10}*\z/) |
|
|
) { |
|
|
|
|
|
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'; |
|
|
|
|
|
; |
|
854 |
} |
} |
855 |
unless ( |
if (defined $_[1]) { |
856 |
($qualifiedName =~ /\A\p{InXML_NCNameStartChar10}\p{InXMLNCNameChar10}*(?::\p{InXML_NCNameStartChar10}\p{InXMLNCNameChar10}*)?\z/) |
$$self->{manakai_entity_base_uri} = ''.$_[1]; |
857 |
) { |
} else { |
858 |
|
delete $$self->{manakai_entity_base_uri}; |
|
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'; |
|
|
|
|
|
; |
|
859 |
} |
} |
860 |
} |
} |
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
if |
|
|
(defined $prefix) { |
|
|
if (not defined $namespaceURI) { |
|
|
|
|
|
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'; |
|
|
|
|
|
; |
|
|
} elsif ($prefix eq 'xml' and $namespaceURI ne |
|
|
'http://www.w3.org/XML/1998/namespace' |
|
|
) { |
|
|
|
|
|
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'; |
|
|
|
|
|
; |
|
|
} elsif ($prefix eq 'xmlns' and $namespaceURI ne |
|
|
'http://www.w3.org/2000/xmlns/' |
|
|
) { |
|
|
|
|
|
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'; |
|
|
|
|
|
; |
|
|
} elsif ($namespaceURI eq |
|
|
'http://www.w3.org/XML/1998/namespace' and |
|
|
$prefix ne 'xml') { |
|
|
|
|
|
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'; |
|
|
|
|
|
; |
|
|
} elsif ($namespaceURI eq |
|
|
'http://www.w3.org/2000/xmlns/' and |
|
|
$prefix ne 'xmlns') { |
|
|
|
|
|
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'; |
|
|
|
|
|
; |
|
|
} |
|
|
} else { ## No prefix |
|
|
if (not defined $namespaceURI) { |
|
|
# |
|
|
} elsif ($namespaceURI eq |
|
|
'http://www.w3.org/2000/xmlns/' and |
|
|
$lname ne 'xmlns') { |
|
|
|
|
|
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'; |
|
|
|
|
|
; |
|
|
} |
|
|
} |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
if (defined $namespaceURI and $namespaceURI eq |
|
|
'http://www.w3.org/2000/xmlns/' and |
|
|
|
|
|
($qualifiedName eq 'xmlns' or |
|
|
(defined $prefix and $prefix eq 'xmlns'))) { |
|
|
|
|
|
report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NAMESPACE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'create_element_ns', 'http://www.w3.org/2001/04/infoset#prefix' => $prefix, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Document::ManakaiDOMDocument', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => 'qualifiedName', 'http://www.w3.org/2001/04/infoset#localName' => $lname, 'http://www.w3.org/2001/04/infoset#namespaceName' => $namespaceURI, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#MDOM_NS_OTHER_WITH_XMLNS_URI'; |
|
|
|
|
|
; |
|
|
} |
|
|
} |
|
|
|
|
|
my $bag = |
|
|
$self->{'b'} |
|
|
; |
|
|
my $stem; |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$stem = 'Message::DOM::Element::ManakaiDOMElement'->___create_node_stem ($bag, { |
|
|
|
|
|
'rc' |
|
|
=> 0, |
|
861 |
|
|
862 |
'id' |
if (defined $$self->{manakai_entity_base_uri}) { |
863 |
=> \ |
return $$self->{manakai_entity_base_uri}; |
|
( |
|
|
'tag:suika.fam.cx,2005-09:' . time . ':' . $$ . ':' . |
|
|
($Message::Util::ManakaiNode::UniqueIDR ||= |
|
|
[qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z |
|
|
a b c d e f g h i j k l m n o p q r s t u v w x y z |
|
|
0 1 2 3 4 5 6 7 8 9/]->[rand 62] . |
|
|
[qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z |
|
|
a b c d e f g h i j k l m n o p q r s t u v w x y z |
|
|
0 1 2 3 4 5 6 7 8 9/]->[rand 62] . |
|
|
[qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z |
|
|
a b c d e f g h i j k l m n o p q r s t u v w x y z |
|
|
0 1 2 3 4 5 6 7 8 9/]->[rand 62] . |
|
|
[qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z |
|
|
a b c d e f g h i j k l m n o p q r s t u v w x y z |
|
|
0 1 2 3 4 5 6 7 8 9/]->[rand 62] . |
|
|
[qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z |
|
|
a b c d e f g h i j k l m n o p q r s t u v w x y z |
|
|
0 1 2 3 4 5 6 7 8 9/]->[rand 62]) . |
|
|
(++$Message::Util::ManakaiNode::UniqueIDN) |
|
|
) |
|
|
, |
|
|
}, { |
|
|
'od' => $self, |
|
|
'ns' => \$namespaceURI, |
|
|
'pfx' => \$prefix, |
|
|
'ln' => \$lname, |
|
|
}); |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
if |
|
|
(defined 'Message::DOM::Element::ManakaiDOMElement') { |
|
|
if (ref 'Message::DOM::Element::ManakaiDOMElement' eq 'SCALAR') { |
|
|
$stem->{'cls'} = 'Message::DOM::Element::ManakaiDOMElement'; |
|
|
} elsif (defined $Message::Util::ManakaiStringRef::Value{'Message::DOM::Element::ManakaiDOMElement'}) { |
|
|
$stem->{'cls'} = $Message::Util::ManakaiStringRef::Value{'Message::DOM::Element::ManakaiDOMElement'}; |
|
864 |
} else { |
} else { |
865 |
require Scalar::Util; |
return $$self->{document_uri}; |
|
$stem->{'cls'} = $Message::Util::ManakaiStringRef::Value{'Message::DOM::Element::ManakaiDOMElement'} = \('Message::DOM::Element::ManakaiDOMElement'); |
|
|
Scalar::Util::weaken ($Message::Util::ManakaiStringRef::Value{'Message::DOM::Element::ManakaiDOMElement'}); |
|
866 |
} |
} |
867 |
} else { |
} # manakai_entity_base_uri |
|
CORE::delete $stem->{'cls'}; |
|
|
} |
|
|
|
|
|
|
|
|
} |
|
868 |
|
|
869 |
; |
sub input_encoding ($;$); |
|
$bag->{${$stem->{ |
|
|
'id' |
|
|
}}} = $stem; |
|
870 |
|
|
871 |
|
sub strict_error_checking ($;$) { |
872 |
} |
## NOTE: Same as trivial boolean accessor, except no read-only checking. |
873 |
|
if (@_ > 1) { |
874 |
; |
if ($_[1]) { |
875 |
|
${$_[0]}->{strict_error_checking} = 1; |
876 |
|
} else { |
877 |
{ |
delete ${$_[0]}->{strict_error_checking}; |
|
|
|
|
|
|
|
$r = ${$stem->{ |
|
|
'cls' |
|
|
}}->___create_node_ref ({ |
|
|
|
|
|
'id' |
|
|
=> $stem->{ |
|
|
'id' |
|
|
}, |
|
|
|
|
|
'b' |
|
|
=> $bag, |
|
|
}, { |
|
|
}); |
|
|
$stem->{ |
|
|
'rc' |
|
|
}++; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
|
|
|
## Default attributes |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth + 1; |
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
XDA: |
|
|
{ |
|
|
my $__cfg = $self-> |
|
|
dom_config |
|
|
; |
|
|
last XDA unless $__cfg-> |
|
|
get_parameter |
|
|
|
|
|
( |
|
|
'http://suika.fam.cx/www/2006/dom-config/dtd-default-attribute' |
|
|
); |
|
|
my $__doctype = $self-> |
|
|
doctype |
|
|
; |
|
|
last XDA unless defined $__doctype; |
|
|
$__doctype = $__doctype-> |
|
|
get_feature |
|
|
|
|
|
( |
|
|
'http://suika.fam.cx/www/2006/feature/XDoctype' |
|
|
=> '3.0'); |
|
|
last XDA unless defined $__doctype; |
|
|
my $__et = $__doctype-> |
|
|
get_element_type_definition_node |
|
|
|
|
|
($qualifiedName); |
|
|
if ($__et) { |
|
|
my $__orig_strict = $self-> |
|
|
strict_error_checking |
|
|
; |
|
|
$self-> |
|
|
strict_error_checking |
|
|
( |
|
|
0 |
|
|
); |
|
|
my %__gattr; |
|
|
my %__has_attr; |
|
|
my %__pfx_to_uri; |
|
|
my $__copy_asis = $__cfg-> |
|
|
get_parameter |
|
|
|
|
|
( |
|
|
'http://suika.fam.cx/www/2006/dom-config/clone-entity-reference-subtree' |
|
|
); |
|
|
$__cfg-> |
|
|
set_parameter |
|
|
|
|
|
( |
|
|
'http://suika.fam.cx/www/2006/dom-config/clone-entity-reference-subtree' |
|
|
=> |
|
|
1 |
|
|
); |
|
|
for my $__at (@{$__et-> |
|
|
attribute_definitions |
|
|
}) { |
|
|
my $__at_default = $__at-> |
|
|
default_type |
|
|
; |
|
|
if ($__at_default == |
|
|
'4' or |
|
|
|
|
|
$__at_default == |
|
|
'1' |
|
|
) { |
|
|
my ($__nn1, $__nn2) = split /:/, $__at-> |
|
|
node_name |
|
|
; |
|
|
if (defined $__nn2) { # prefixed |
|
|
if ($__nn1 eq 'xmlns') { |
|
|
## TODO: NCName check, prefix check and NSURI check |
|
|
my $__attr = $self-> |
|
|
create_attribute_ns |
|
|
|
|
|
( |
|
|
'http://www.w3.org/2000/xmlns/' |
|
|
, [$__nn1, $__nn2]); |
|
|
for my $__at_child (@{$__at-> |
|
|
child_nodes |
|
|
}) { |
|
|
$__attr-> |
|
|
append_child |
|
|
|
|
|
($__at_child-> |
|
|
clone_node |
|
|
( |
|
|
1 |
|
|
)); |
|
|
} |
|
|
$__attr-> |
|
|
manakai_attribute_type |
|
|
|
|
|
($__at-> |
|
|
declared_type |
|
|
); |
|
|
my $__nsuri = $__attr-> |
|
|
value |
|
|
; |
|
|
## TODO: Namespace well-formedness check (NSURI), v1.1 chk |
|
|
$__pfx_to_uri{$__nn2} = $__nsuri; |
|
|
$r-> |
|
|
set_attribute_node_ns |
|
|
($__attr); |
|
|
## This method changes |specified| flag |
|
|
$__attr-> |
|
|
specified |
|
|
( |
|
|
0 |
|
|
); |
|
|
$__has_attr{ |
|
|
'http://www.w3.org/2000/xmlns/' |
|
|
}->{$__nn2} = |
|
|
1 |
|
|
; |
|
|
} else { |
|
|
## TODO: NCName check |
|
|
$__gattr{$__nn1}->{$__nn2} = $__at; |
|
|
} |
|
|
} else { # no prefixed |
|
|
my $__attr; |
|
|
if ($__nn1 eq 'xmlns') { |
|
|
$__attr = $self-> |
|
|
create_attribute_ns |
|
|
|
|
|
( |
|
|
'http://www.w3.org/2000/xmlns/' |
|
|
, 'xmlns'); |
|
|
$__has_attr{ |
|
|
'http://www.w3.org/2000/xmlns/' |
|
|
}->{xmlns} = |
|
|
1 |
|
|
; |
|
|
} else { |
|
|
$__attr = $self-> |
|
|
create_attribute_ns |
|
|
|
|
|
( |
|
|
undef |
|
|
, $__nn1); |
|
|
## TODO: NCName check |
|
|
} |
|
|
for my $__at_child (@{$__at-> |
|
|
child_nodes |
|
|
}) { |
|
|
$__attr-> |
|
|
append_child |
|
|
|
|
|
($__at_child-> |
|
|
clone_node |
|
|
( |
|
|
1 |
|
|
)); |
|
|
} |
|
|
$__attr-> |
|
|
manakai_attribute_type |
|
|
|
|
|
($__at-> |
|
|
declared_type |
|
|
); |
|
|
## TODO: Namespace well-formedness check (NSURI) |
|
|
$r-> |
|
|
set_attribute_node_ns |
|
|
($__attr); |
|
|
## This method changes |specified| flag |
|
|
$__attr-> |
|
|
specified |
|
|
( |
|
|
0 |
|
|
); |
|
|
} |
|
|
} |
|
|
} # attrdefs |
|
|
for my $__pfx (keys %__gattr) { |
|
|
my $__nsuri = $__pfx_to_uri{$__pfx}; |
|
|
unless (defined $__nsuri) { |
|
|
## TODO: Namespace well-formedness error |
|
|
} |
|
|
LN: for my $__ln (keys %{$__gattr{$__pfx}}) { |
|
|
if ($__has_attr{defined $__nsuri ? $__nsuri : ''}->{$__ln}) { |
|
|
## TODO: Namespace well-formedness error |
|
|
next LN; |
|
|
} |
|
|
## TODO: NCName check, prefix check and NSURI check |
|
|
my $__at = $__gattr{$__pfx}->{$__ln}; |
|
|
my $__attr = $self-> |
|
|
create_attribute_ns |
|
|
|
|
|
($__nsuri, [$__pfx, $__ln]); |
|
|
for my $__at_child (@{$__at-> |
|
|
child_nodes |
|
|
}) { |
|
|
$__attr-> |
|
|
append_child |
|
|
|
|
|
($__at_child-> |
|
|
clone_node |
|
|
( |
|
|
1 |
|
|
)); |
|
|
} |
|
|
$__attr-> |
|
|
manakai_attribute_type |
|
|
|
|
|
($__at-> |
|
|
declared_type |
|
|
); |
|
|
$r-> |
|
|
set_attribute_node_ns |
|
|
($__attr); |
|
|
## This method changes |specified| flag |
|
|
$__attr-> |
|
|
specified |
|
|
( |
|
|
0 |
|
|
); |
|
|
$__has_attr{defined $__nsuri ? $__nsuri : ''}->{$__ln} = |
|
|
1 |
|
|
; |
|
|
} # LN |
|
|
} # pfx |
|
|
$__cfg-> |
|
|
set_parameter |
|
|
|
|
|
( |
|
|
'http://suika.fam.cx/www/2006/dom-config/clone-entity-reference-subtree' |
|
|
=> $__copy_asis); |
|
|
$self-> |
|
|
strict_error_checking |
|
|
($__orig_strict); |
|
|
} |
|
|
} # XDA |
|
|
|
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
;} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
} |
|
|
$r} |
|
|
sub create_attribute ($$) { |
|
|
my ($self, $name) = @_; |
|
|
my $r; |
|
|
|
|
|
{ |
|
|
|
|
|
my |
|
|
$strict = $self-> |
|
|
strict_error_checking |
|
|
; |
|
|
if ($strict) { |
|
|
my $version = $self-> |
|
|
xml_version |
|
|
; |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
if |
|
|
(defined $name) { |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
if |
|
|
(((not defined $version or $version eq '1.0') and |
|
|
not |
|
|
($name =~ /\A\p{InXML_NameStartChar10}\p{InXMLNameChar10}*\z/) |
|
|
) or |
|
|
(defined $version and $version eq '1.1' and |
|
|
not |
|
|
($name =~ /\A\p{InXMLNameStartChar11}\p{InXMLNameChar11}*\z/) |
|
|
)) { |
|
|
|
|
|
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'; |
|
|
|
|
|
; |
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
; |
|
|
} |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
} |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth + 1; |
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
|
|
|
$self-> |
|
|
strict_error_checking |
|
|
( |
|
|
0 |
|
|
); |
|
|
$r = $self-> |
|
|
create_attribute_ns |
|
|
( |
|
|
undef |
|
|
, [ |
|
|
undef |
|
|
, $name]); |
|
|
$self-> |
|
|
strict_error_checking |
|
|
($strict); |
|
|
|
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
;} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
} |
|
|
$r} |
|
|
sub create_attribute_ns ($$$) { |
|
|
my ($self, $namespaceURI, $qualifiedName) = @_; |
|
|
|
|
|
{ |
|
|
|
|
|
if |
|
|
(CORE::defined $namespaceURI and CORE::length $namespaceURI == 0) { |
|
|
|
|
|
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:1144080824:30455:ZO0D78781+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest'; |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$namespaceURI = undef; |
|
|
|
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
} |
|
|
|
|
|
|
|
|
} |
|
|
my $r; |
|
|
|
|
|
{ |
|
|
|
|
|
require |
|
|
Message::DOM::Element; |
|
|
|
|
|
my ($prefix, $lname) = ref $qualifiedName eq 'ARRAY' |
|
|
? @$qualifiedName |
|
|
: split /:/, $qualifiedName, 2; |
|
|
($prefix, $lname) = ( |
|
|
undef |
|
|
, $prefix) unless defined $lname; |
|
|
|
|
|
## TODO: autoload |
|
|
if ((defined $namespaceURI and $namespaceURI eq |
|
|
'http://www.w3.org/XML/1998/namespace' |
|
|
) or |
|
|
($lname =~ /^xml:/)) { |
|
|
require Message::DOM::XML; |
|
|
} |
|
|
|
|
|
if ($self-> |
|
|
strict_error_checking |
|
|
) { |
|
|
my $version = $self-> |
|
|
xml_version |
|
|
; |
|
|
$qualifiedName = defined $prefix ? $prefix.':'.$lname |
|
|
: $lname; |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
if |
|
|
(defined $version and $version eq '1.1') { |
|
|
unless ( |
|
|
($qualifiedName =~ /\A\p{InXMLNameStartChar11}\p{InXMLNameChar11}*\z/) |
|
|
) { |
|
|
|
|
|
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'; |
|
|
|
|
|
; |
|
878 |
} |
} |
879 |
unless ( |
} |
880 |
($qualifiedName =~ /\A\p{InXMLNCNameStartChar11}\p{InXMLNCNameChar11}*(?::\p{InXMLNCNameStartChar11}\p{InXMLNCNameChar11}*)?\z/) |
return ${$_[0]}->{strict_error_checking}; |
881 |
) { |
} # strict_error_checking |
|
|
|
|
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'; |
|
882 |
|
|
883 |
; |
## ISSUE: Setting manakai_is_html true shadows |
884 |
} |
## xml_* properties. Is this desired? |
|
} else { |
|
|
unless ( |
|
|
($qualifiedName =~ /\A\p{InXML_NameStartChar10}\p{InXMLNameChar10}*\z/) |
|
|
) { |
|
|
|
|
|
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'; |
|
885 |
|
|
886 |
; |
sub xml_encoding ($;$) { |
887 |
|
my $self = $_[0]; |
888 |
|
if (@_ > 1) { |
889 |
|
## NOTE: A manakai extension. |
890 |
|
if ($$self->{strict_error_checking}) { |
891 |
|
if ($$self->{manakai_is_html}) { |
892 |
|
report Message::DOM::DOMException |
893 |
|
-object => $self, |
894 |
|
-type => 'NOT_SUPPORTED_ERR', |
895 |
|
-subtype => 'NON_HTML_OPERATION_ERR'; |
896 |
|
} |
897 |
|
if ($$self->{manakai_read_only}) { |
898 |
|
report Message::DOM::DOMException |
899 |
|
-object => $self, |
900 |
|
-type => 'NO_MODIFICATION_ALLOWED_ERR', |
901 |
|
-subtype => 'READ_ONLY_NODE_ERR'; |
902 |
|
} |
903 |
} |
} |
904 |
unless ( |
if (defined $_[1]) { |
905 |
($qualifiedName =~ /\A\p{InXML_NCNameStartChar10}\p{InXMLNCNameChar10}*(?::\p{InXML_NCNameStartChar10}\p{InXMLNCNameChar10}*)?\z/) |
$$self->{xml_encoding} = ''.$_[1]; |
906 |
) { |
} else { |
907 |
|
delete $$self->{xml_encoding}; |
|
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'; |
|
|
|
|
|
; |
|
908 |
} |
} |
909 |
} |
} |
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
if |
|
|
(defined $prefix) { |
|
|
if (not defined $namespaceURI) { |
|
|
|
|
|
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'; |
|
|
|
|
|
; |
|
|
} elsif ($prefix eq 'xml' and $namespaceURI ne |
|
|
'http://www.w3.org/XML/1998/namespace' |
|
|
) { |
|
|
|
|
|
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'; |
|
|
|
|
|
; |
|
|
} elsif ($prefix eq 'xmlns' and $namespaceURI ne |
|
|
'http://www.w3.org/2000/xmlns/' |
|
|
) { |
|
|
|
|
|
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'; |
|
|
|
|
|
; |
|
|
} elsif ($namespaceURI eq |
|
|
'http://www.w3.org/XML/1998/namespace' and |
|
|
$prefix ne 'xml') { |
|
|
|
|
|
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'; |
|
|
|
|
|
; |
|
|
} elsif ($namespaceURI eq |
|
|
'http://www.w3.org/2000/xmlns/' and |
|
|
$prefix ne 'xmlns') { |
|
|
|
|
|
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'; |
|
|
|
|
|
; |
|
|
} |
|
|
} else { ## No prefix |
|
|
if (not defined $namespaceURI) { |
|
|
# |
|
|
} elsif ($namespaceURI eq |
|
|
'http://www.w3.org/2000/xmlns/' and |
|
|
$lname ne 'xmlns') { |
|
|
|
|
|
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'; |
|
|
|
|
|
; |
|
|
} |
|
|
} |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
} |
|
|
|
|
|
my $bag = |
|
|
$self->{'b'} |
|
|
; |
|
|
my $stem; |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$stem = 'Message::DOM::Element::ManakaiDOMAttr'->___create_node_stem ($bag, { |
|
|
|
|
|
'rc' |
|
|
=> 0, |
|
910 |
|
|
911 |
'id' |
if ($$self->{manakai_is_html}) { |
912 |
=> \ |
return undef; |
|
( |
|
|
'tag:suika.fam.cx,2005-09:' . time . ':' . $$ . ':' . |
|
|
($Message::Util::ManakaiNode::UniqueIDR ||= |
|
|
[qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z |
|
|
a b c d e f g h i j k l m n o p q r s t u v w x y z |
|
|
0 1 2 3 4 5 6 7 8 9/]->[rand 62] . |
|
|
[qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z |
|
|
a b c d e f g h i j k l m n o p q r s t u v w x y z |
|
|
0 1 2 3 4 5 6 7 8 9/]->[rand 62] . |
|
|
[qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z |
|
|
a b c d e f g h i j k l m n o p q r s t u v w x y z |
|
|
0 1 2 3 4 5 6 7 8 9/]->[rand 62] . |
|
|
[qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z |
|
|
a b c d e f g h i j k l m n o p q r s t u v w x y z |
|
|
0 1 2 3 4 5 6 7 8 9/]->[rand 62] . |
|
|
[qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z |
|
|
a b c d e f g h i j k l m n o p q r s t u v w x y z |
|
|
0 1 2 3 4 5 6 7 8 9/]->[rand 62]) . |
|
|
(++$Message::Util::ManakaiNode::UniqueIDN) |
|
|
) |
|
|
, |
|
|
}, { |
|
|
'od' => $self, |
|
|
'ns' => \$namespaceURI, |
|
|
'pfx' => \$prefix, |
|
|
'ln' => \$lname, |
|
|
'specified' => 1, |
|
|
}); |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
if |
|
|
(defined 'Message::DOM::Element::ManakaiDOMAttr') { |
|
|
if (ref 'Message::DOM::Element::ManakaiDOMAttr' eq 'SCALAR') { |
|
|
$stem->{'cls'} = 'Message::DOM::Element::ManakaiDOMAttr'; |
|
|
} elsif (defined $Message::Util::ManakaiStringRef::Value{'Message::DOM::Element::ManakaiDOMAttr'}) { |
|
|
$stem->{'cls'} = $Message::Util::ManakaiStringRef::Value{'Message::DOM::Element::ManakaiDOMAttr'}; |
|
913 |
} else { |
} else { |
914 |
require Scalar::Util; |
return $$self->{xml_encoding}; |
|
$stem->{'cls'} = $Message::Util::ManakaiStringRef::Value{'Message::DOM::Element::ManakaiDOMAttr'} = \('Message::DOM::Element::ManakaiDOMAttr'); |
|
|
Scalar::Util::weaken ($Message::Util::ManakaiStringRef::Value{'Message::DOM::Element::ManakaiDOMAttr'}); |
|
915 |
} |
} |
916 |
} else { |
} # xml_encoding |
|
CORE::delete $stem->{'cls'}; |
|
|
} |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
$bag->{${$stem->{ |
|
|
'id' |
|
|
}}} = $stem; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
917 |
|
|
918 |
|
sub xml_standalone ($;$) { |
919 |
{ |
my $self = $_[0]; |
920 |
|
if (@_ > 1) { |
921 |
|
if ($$self->{strict_error_checking}) { |
922 |
$r = ${$stem->{ |
if ($$self->{manakai_is_html}) { |
923 |
'cls' |
report Message::DOM::DOMException |
924 |
}}->___create_node_ref ({ |
-object => $self, |
925 |
|
-type => 'NOT_SUPPORTED_ERR', |
926 |
'id' |
-subtype => 'NON_HTML_OPERATION_ERR'; |
927 |
=> $stem->{ |
} |
928 |
'id' |
## NOTE: Not in DOM3. |
929 |
}, |
if ($$self->{manakai_read_only}) { |
930 |
|
report Message::DOM::DOMException |
931 |
'b' |
-object => $self, |
932 |
=> $bag, |
-type => 'NO_MODIFICATION_ALLOWED_ERR', |
933 |
}, { |
-subtype => 'READ_ONLY_NODE_ERR'; |
934 |
}); |
} |
|
$stem->{ |
|
|
'rc' |
|
|
}++; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
|
|
|
## Attribute type information |
|
|
if ((defined $namespaceURI and $namespaceURI eq |
|
|
'http://www.w3.org/XML/1998/namespace' and |
|
|
|
|
|
$lname eq 'id') or |
|
|
(not defined $namespaceURI and $lname eq 'xml:id')) { |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth + 1; |
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
if |
|
|
($self-> |
|
|
dom_config |
|
|
|
|
|
-> |
|
|
get_parameter |
|
|
|
|
|
( |
|
|
'http://suika.fam.cx/www/2006/dom-config/xml-id' |
|
|
)) { |
|
|
$r-> |
|
|
manakai_attribute_type |
|
|
( |
|
|
'2' |
|
|
); |
|
935 |
} |
} |
936 |
|
if ($_[1]) { |
937 |
|
$$self->{xml_standalone} = 1; |
938 |
|
} else { |
939 |
} |
delete $$self->{xml_standalone}; |
|
|
|
|
|
|
|
;} |
|
|
|
|
|
; |
|
|
} |
|
|
|
|
|
|
|
|
} |
|
|
$r} |
|
|
sub create_text_node ($$) { |
|
|
my ($self, $data) = @_; |
|
|
my $r; |
|
|
|
|
|
{ |
|
|
|
|
|
my |
|
|
$bag = |
|
|
$self->{'b'} |
|
|
; |
|
|
my $stem; |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$stem = 'Message::DOM::TreeCore::ManakaiDOMText'->___create_node_stem ($bag, { |
|
|
|
|
|
'rc' |
|
|
=> 0, |
|
|
|
|
|
'id' |
|
|
=> \ |
|
|
( |
|
|
'tag:suika.fam.cx,2005-09:' . time . ':' . $$ . ':' . |
|
|
($Message::Util::ManakaiNode::UniqueIDR ||= |
|
|
[qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z |
|
|
a b c d e f g h i j k l m n o p q r s t u v w x y z |
|
|
0 1 2 3 4 5 6 7 8 9/]->[rand 62] . |
|
|
[qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z |
|
|
a b c d e f g h i j k l m n o p q r s t u v w x y z |
|
|
0 1 2 3 4 5 6 7 8 9/]->[rand 62] . |
|
|
[qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z |
|
|
a b c d e f g h i j k l m n o p q r s t u v w x y z |
|
|
0 1 2 3 4 5 6 7 8 9/]->[rand 62] . |
|
|
[qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z |
|
|
a b c d e f g h i j k l m n o p q r s t u v w x y z |
|
|
0 1 2 3 4 5 6 7 8 9/]->[rand 62] . |
|
|
[qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z |
|
|
a b c d e f g h i j k l m n o p q r s t u v w x y z |
|
|
0 1 2 3 4 5 6 7 8 9/]->[rand 62]) . |
|
|
(++$Message::Util::ManakaiNode::UniqueIDN) |
|
|
) |
|
|
, |
|
|
}, { |
|
|
'od' => $self, |
|
|
'con' => \$data, |
|
|
}); |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
if |
|
|
(defined 'Message::DOM::TreeCore::ManakaiDOMText') { |
|
|
if (ref 'Message::DOM::TreeCore::ManakaiDOMText' eq 'SCALAR') { |
|
|
$stem->{'cls'} = 'Message::DOM::TreeCore::ManakaiDOMText'; |
|
|
} elsif (defined $Message::Util::ManakaiStringRef::Value{'Message::DOM::TreeCore::ManakaiDOMText'}) { |
|
|
$stem->{'cls'} = $Message::Util::ManakaiStringRef::Value{'Message::DOM::TreeCore::ManakaiDOMText'}; |
|
|
} else { |
|
|
require Scalar::Util; |
|
|
$stem->{'cls'} = $Message::Util::ManakaiStringRef::Value{'Message::DOM::TreeCore::ManakaiDOMText'} = \('Message::DOM::TreeCore::ManakaiDOMText'); |
|
|
Scalar::Util::weaken ($Message::Util::ManakaiStringRef::Value{'Message::DOM::TreeCore::ManakaiDOMText'}); |
|
|
} |
|
|
} else { |
|
|
CORE::delete $stem->{'cls'}; |
|
|
} |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
$bag->{${$stem->{ |
|
|
'id' |
|
|
}}} = $stem; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$r = ${$stem->{ |
|
|
'cls' |
|
|
}}->___create_node_ref ({ |
|
|
|
|
|
'id' |
|
|
=> $stem->{ |
|
|
'id' |
|
|
}, |
|
|
|
|
|
'b' |
|
|
=> $bag, |
|
|
}, { |
|
|
}); |
|
|
$stem->{ |
|
|
'rc' |
|
|
}++; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
} |
|
|
$r} |
|
|
sub create_cdata_section ($$) { |
|
|
my ($self, $data) = @_; |
|
|
my $r; |
|
|
|
|
|
{ |
|
|
|
|
|
require |
|
|
Message::DOM::XML; |
|
|
my $bag = |
|
|
$self->{'b'} |
|
|
; |
|
|
my $stem; |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$stem = 'Message::DOM::XML::ManakaiDOMCDATASection'->___create_node_stem ($bag, { |
|
|
|
|
|
'rc' |
|
|
=> 0, |
|
|
|
|
|
'id' |
|
|
=> \ |
|
|
( |
|
|
'tag:suika.fam.cx,2005-09:' . time . ':' . $$ . ':' . |
|
|
($Message::Util::ManakaiNode::UniqueIDR ||= |
|
|
[qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z |
|
|
a b c d e f g h i j k l m n o p q r s t u v w x y z |
|
|
0 1 2 3 4 5 6 7 8 9/]->[rand 62] . |
|
|
[qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z |
|
|
a b c d e f g h i j k l m n o p q r s t u v w x y z |
|
|
0 1 2 3 4 5 6 7 8 9/]->[rand 62] . |
|
|
[qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z |
|
|
a b c d e f g h i j k l m n o p q r s t u v w x y z |
|
|
0 1 2 3 4 5 6 7 8 9/]->[rand 62] . |
|
|
[qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z |
|
|
a b c d e f g h i j k l m n o p q r s t u v w x y z |
|
|
0 1 2 3 4 5 6 7 8 9/]->[rand 62] . |
|
|
[qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z |
|
|
a b c d e f g h i j k l m n o p q r s t u v w x y z |
|
|
0 1 2 3 4 5 6 7 8 9/]->[rand 62]) . |
|
|
(++$Message::Util::ManakaiNode::UniqueIDN) |
|
|
) |
|
|
, |
|
|
}, { |
|
|
'od' => $self, |
|
|
'con' => \$data, |
|
|
}); |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
if |
|
|
(defined 'Message::DOM::XML::ManakaiDOMCDATASection') { |
|
|
if (ref 'Message::DOM::XML::ManakaiDOMCDATASection' eq 'SCALAR') { |
|
|
$stem->{'cls'} = 'Message::DOM::XML::ManakaiDOMCDATASection'; |
|
|
} elsif (defined $Message::Util::ManakaiStringRef::Value{'Message::DOM::XML::ManakaiDOMCDATASection'}) { |
|
|
$stem->{'cls'} = $Message::Util::ManakaiStringRef::Value{'Message::DOM::XML::ManakaiDOMCDATASection'}; |
|
|
} else { |
|
|
require Scalar::Util; |
|
|
$stem->{'cls'} = $Message::Util::ManakaiStringRef::Value{'Message::DOM::XML::ManakaiDOMCDATASection'} = \('Message::DOM::XML::ManakaiDOMCDATASection'); |
|
|
Scalar::Util::weaken ($Message::Util::ManakaiStringRef::Value{'Message::DOM::XML::ManakaiDOMCDATASection'}); |
|
|
} |
|
|
} else { |
|
|
CORE::delete $stem->{'cls'}; |
|
|
} |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
$bag->{${$stem->{ |
|
|
'id' |
|
|
}}} = $stem; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$r = ${$stem->{ |
|
|
'cls' |
|
|
}}->___create_node_ref ({ |
|
|
|
|
|
'id' |
|
|
=> $stem->{ |
|
|
'id' |
|
|
}, |
|
|
|
|
|
'b' |
|
|
=> $bag, |
|
|
}, { |
|
|
}); |
|
|
$stem->{ |
|
|
'rc' |
|
|
}++; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
} |
|
|
$r} |
|
|
sub create_comment ($$) { |
|
|
my ($self, $data) = @_; |
|
|
my $r; |
|
|
|
|
|
{ |
|
|
|
|
|
my |
|
|
$bag = |
|
|
$self->{'b'} |
|
|
; |
|
|
my $stem; |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$stem = 'Message::DOM::TreeCore::ManakaiDOMComment'->___create_node_stem ($bag, { |
|
|
|
|
|
'rc' |
|
|
=> 0, |
|
|
|
|
|
'id' |
|
|
=> \ |
|
|
( |
|
|
'tag:suika.fam.cx,2005-09:' . time . ':' . $$ . ':' . |
|
|
($Message::Util::ManakaiNode::UniqueIDR ||= |
|
|
[qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z |
|
|
a b c d e f g h i j k l m n o p q r s t u v w x y z |
|
|
0 1 2 3 4 5 6 7 8 9/]->[rand 62] . |
|
|
[qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z |
|
|
a b c d e f g h i j k l m n o p q r s t u v w x y z |
|
|
0 1 2 3 4 5 6 7 8 9/]->[rand 62] . |
|
|
[qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z |
|
|
a b c d e f g h i j k l m n o p q r s t u v w x y z |
|
|
0 1 2 3 4 5 6 7 8 9/]->[rand 62] . |
|
|
[qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z |
|
|
a b c d e f g h i j k l m n o p q r s t u v w x y z |
|
|
0 1 2 3 4 5 6 7 8 9/]->[rand 62] . |
|
|
[qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z |
|
|
a b c d e f g h i j k l m n o p q r s t u v w x y z |
|
|
0 1 2 3 4 5 6 7 8 9/]->[rand 62]) . |
|
|
(++$Message::Util::ManakaiNode::UniqueIDN) |
|
|
) |
|
|
, |
|
|
}, { |
|
|
'od' => $self, |
|
|
'con' => \$data, |
|
|
}); |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
if |
|
|
(defined 'Message::DOM::TreeCore::ManakaiDOMComment') { |
|
|
if (ref 'Message::DOM::TreeCore::ManakaiDOMComment' eq 'SCALAR') { |
|
|
$stem->{'cls'} = 'Message::DOM::TreeCore::ManakaiDOMComment'; |
|
|
} elsif (defined $Message::Util::ManakaiStringRef::Value{'Message::DOM::TreeCore::ManakaiDOMComment'}) { |
|
|
$stem->{'cls'} = $Message::Util::ManakaiStringRef::Value{'Message::DOM::TreeCore::ManakaiDOMComment'}; |
|
|
} else { |
|
|
require Scalar::Util; |
|
|
$stem->{'cls'} = $Message::Util::ManakaiStringRef::Value{'Message::DOM::TreeCore::ManakaiDOMComment'} = \('Message::DOM::TreeCore::ManakaiDOMComment'); |
|
|
Scalar::Util::weaken ($Message::Util::ManakaiStringRef::Value{'Message::DOM::TreeCore::ManakaiDOMComment'}); |
|
|
} |
|
|
} else { |
|
|
CORE::delete $stem->{'cls'}; |
|
|
} |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
$bag->{${$stem->{ |
|
|
'id' |
|
|
}}} = $stem; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$r = ${$stem->{ |
|
|
'cls' |
|
|
}}->___create_node_ref ({ |
|
|
|
|
|
'id' |
|
|
=> $stem->{ |
|
|
'id' |
|
|
}, |
|
|
|
|
|
'b' |
|
|
=> $bag, |
|
|
}, { |
|
|
}); |
|
|
$stem->{ |
|
|
'rc' |
|
|
}++; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
} |
|
|
$r} |
|
|
sub create_document_fragment ($) { |
|
|
my ($self) = @_; |
|
|
my $r; |
|
|
|
|
|
{ |
|
|
|
|
|
my |
|
|
$bag = |
|
|
$self->{'b'} |
|
|
; |
|
|
my $stem; |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$stem = 'Message::DOM::Document::ManakaiDOMDocumentFragment'->___create_node_stem ($bag, { |
|
|
|
|
|
'rc' |
|
|
=> 0, |
|
|
|
|
|
'id' |
|
|
=> \ |
|
|
( |
|
|
'tag:suika.fam.cx,2005-09:' . time . ':' . $$ . ':' . |
|
|
($Message::Util::ManakaiNode::UniqueIDR ||= |
|
|
[qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z |
|
|
a b c d e f g h i j k l m n o p q r s t u v w x y z |
|
|
0 1 2 3 4 5 6 7 8 9/]->[rand 62] . |
|
|
[qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z |
|
|
a b c d e f g h i j k l m n o p q r s t u v w x y z |
|
|
0 1 2 3 4 5 6 7 8 9/]->[rand 62] . |
|
|
[qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z |
|
|
a b c d e f g h i j k l m n o p q r s t u v w x y z |
|
|
0 1 2 3 4 5 6 7 8 9/]->[rand 62] . |
|
|
[qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z |
|
|
a b c d e f g h i j k l m n o p q r s t u v w x y z |
|
|
0 1 2 3 4 5 6 7 8 9/]->[rand 62] . |
|
|
[qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z |
|
|
a b c d e f g h i j k l m n o p q r s t u v w x y z |
|
|
0 1 2 3 4 5 6 7 8 9/]->[rand 62]) . |
|
|
(++$Message::Util::ManakaiNode::UniqueIDN) |
|
|
) |
|
|
, |
|
|
}, { |
|
|
'od' => $self, |
|
|
}); |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
if |
|
|
(defined 'Message::DOM::Document::ManakaiDOMDocumentFragment') { |
|
|
if (ref 'Message::DOM::Document::ManakaiDOMDocumentFragment' eq 'SCALAR') { |
|
|
$stem->{'cls'} = 'Message::DOM::Document::ManakaiDOMDocumentFragment'; |
|
|
} elsif (defined $Message::Util::ManakaiStringRef::Value{'Message::DOM::Document::ManakaiDOMDocumentFragment'}) { |
|
|
$stem->{'cls'} = $Message::Util::ManakaiStringRef::Value{'Message::DOM::Document::ManakaiDOMDocumentFragment'}; |
|
|
} else { |
|
|
require Scalar::Util; |
|
|
$stem->{'cls'} = $Message::Util::ManakaiStringRef::Value{'Message::DOM::Document::ManakaiDOMDocumentFragment'} = \('Message::DOM::Document::ManakaiDOMDocumentFragment'); |
|
|
Scalar::Util::weaken ($Message::Util::ManakaiStringRef::Value{'Message::DOM::Document::ManakaiDOMDocumentFragment'}); |
|
|
} |
|
|
} else { |
|
|
CORE::delete $stem->{'cls'}; |
|
|
} |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
$bag->{${$stem->{ |
|
|
'id' |
|
|
}}} = $stem; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$r = ${$stem->{ |
|
|
'cls' |
|
|
}}->___create_node_ref ({ |
|
|
|
|
|
'id' |
|
|
=> $stem->{ |
|
|
'id' |
|
|
}, |
|
|
|
|
|
'b' |
|
|
=> $bag, |
|
|
}, { |
|
|
}); |
|
|
$stem->{ |
|
|
'rc' |
|
|
}++; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
} |
|
|
$r} |
|
|
sub create_entity_reference ($$) { |
|
|
my ($self, $name) = @_; |
|
|
my $r; |
|
|
|
|
|
{ |
|
|
|
|
|
require |
|
|
Message::DOM::XML; |
|
|
our $CreateEntityReference_OpenEntity; |
|
|
## NOTE: Multithread unsafe |
|
|
|
|
|
my $orig_strict = $self-> |
|
|
strict_error_checking |
|
|
; |
|
|
if ($orig_strict) { |
|
|
my $version = $self-> |
|
|
xml_version |
|
|
; |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
if |
|
|
(defined $name) { |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
if |
|
|
(((not defined $version or $version eq '1.0') and |
|
|
not |
|
|
($name =~ /\A\p{InXML_NameStartChar10}\p{InXMLNameChar10}*\z/) |
|
|
) or |
|
|
(defined $version and $version eq '1.1' and |
|
|
not |
|
|
($name =~ /\A\p{InXMLNameStartChar11}\p{InXMLNameChar11}*\z/) |
|
|
)) { |
|
|
|
|
|
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'; |
|
|
|
|
|
; |
|
940 |
} |
} |
|
|
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
; |
|
|
} |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
} |
|
|
|
|
|
my $bag = |
|
|
$self->{'b'} |
|
|
; |
|
|
my $stem; |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$stem = 'Message::DOM::XML::ManakaiDOMEntityReference'->___create_node_stem ($bag, { |
|
|
|
|
|
'rc' |
|
|
=> 0, |
|
|
|
|
|
'id' |
|
|
=> \ |
|
|
( |
|
|
'tag:suika.fam.cx,2005-09:' . time . ':' . $$ . ':' . |
|
|
($Message::Util::ManakaiNode::UniqueIDR ||= |
|
|
[qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z |
|
|
a b c d e f g h i j k l m n o p q r s t u v w x y z |
|
|
0 1 2 3 4 5 6 7 8 9/]->[rand 62] . |
|
|
[qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z |
|
|
a b c d e f g h i j k l m n o p q r s t u v w x y z |
|
|
0 1 2 3 4 5 6 7 8 9/]->[rand 62] . |
|
|
[qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z |
|
|
a b c d e f g h i j k l m n o p q r s t u v w x y z |
|
|
0 1 2 3 4 5 6 7 8 9/]->[rand 62] . |
|
|
[qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z |
|
|
a b c d e f g h i j k l m n o p q r s t u v w x y z |
|
|
0 1 2 3 4 5 6 7 8 9/]->[rand 62] . |
|
|
[qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z |
|
|
a b c d e f g h i j k l m n o p q r s t u v w x y z |
|
|
0 1 2 3 4 5 6 7 8 9/]->[rand 62]) . |
|
|
(++$Message::Util::ManakaiNode::UniqueIDN) |
|
|
) |
|
|
, |
|
|
}, { |
|
|
'xname' => \$name, |
|
|
'od' => $self, |
|
|
}); |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
if |
|
|
(defined 'Message::DOM::XML::ManakaiDOMEntityReference') { |
|
|
if (ref 'Message::DOM::XML::ManakaiDOMEntityReference' eq 'SCALAR') { |
|
|
$stem->{'cls'} = 'Message::DOM::XML::ManakaiDOMEntityReference'; |
|
|
} elsif (defined $Message::Util::ManakaiStringRef::Value{'Message::DOM::XML::ManakaiDOMEntityReference'}) { |
|
|
$stem->{'cls'} = $Message::Util::ManakaiStringRef::Value{'Message::DOM::XML::ManakaiDOMEntityReference'}; |
|
|
} else { |
|
|
require Scalar::Util; |
|
|
$stem->{'cls'} = $Message::Util::ManakaiStringRef::Value{'Message::DOM::XML::ManakaiDOMEntityReference'} = \('Message::DOM::XML::ManakaiDOMEntityReference'); |
|
|
Scalar::Util::weaken ($Message::Util::ManakaiStringRef::Value{'Message::DOM::XML::ManakaiDOMEntityReference'}); |
|
|
} |
|
|
} else { |
|
|
CORE::delete $stem->{'cls'}; |
|
|
} |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
$bag->{${$stem->{ |
|
|
'id' |
|
|
}}} = $stem; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$r = ${$stem->{ |
|
|
'cls' |
|
|
}}->___create_node_ref ({ |
|
|
|
|
|
'id' |
|
|
=> $stem->{ |
|
|
'id' |
|
|
}, |
|
|
|
|
|
'b' |
|
|
=> $bag, |
|
|
}, { |
|
|
}); |
|
|
$stem->{ |
|
|
'rc' |
|
|
}++; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
|
|
|
## Expansion |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth + 1; |
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
unless |
|
|
($CreateEntityReference_OpenEntity->{$name}) { |
|
|
local $CreateEntityReference_OpenEntity->{$name} = |
|
|
1 |
|
|
; |
|
|
my $__doctype = $self-> |
|
|
doctype |
|
|
; |
|
|
$__doctype = $__doctype-> |
|
|
get_feature |
|
|
|
|
|
( |
|
|
'http://suika.fam.cx/www/2006/feature/XDoctype' |
|
|
=> '3.0') |
|
|
if $__doctype; |
|
|
if ($__doctype) { |
|
|
my $__et = $__doctype-> |
|
|
get_general_entity_node |
|
|
($name); |
|
|
if ($__et) { |
|
|
$self-> |
|
|
strict_error_checking |
|
|
( |
|
|
0 |
|
|
); |
|
|
my @node; |
|
|
for my $c (@{$__et-> |
|
|
child_nodes |
|
|
}) { |
|
|
my $clone = $c-> |
|
|
clone_node |
|
|
( |
|
|
1 |
|
|
); |
|
|
$r-> |
|
|
append_child |
|
|
($clone); |
|
|
push @node, $clone; |
|
|
} |
|
|
$r-> |
|
|
manakai_expanded |
|
|
|
|
|
($__et-> |
|
|
has_replacement_tree |
|
|
); |
|
|
$self-> |
|
|
strict_error_checking |
|
|
($orig_strict); |
|
|
} # entity |
|
|
} # doctype |
|
941 |
} |
} |
|
$r-> |
|
|
manakai_set_read_only |
|
|
( |
|
|
1 |
|
|
, |
|
|
1 |
|
|
); |
|
|
|
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
;} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
} |
|
|
$r} |
|
|
sub create_processing_instruction ($$$) { |
|
|
my ($self, $target, $data) = @_; |
|
|
my $r; |
|
|
|
|
|
{ |
|
|
|
|
|
require |
|
|
Message::DOM::XML; |
|
|
|
|
|
if ($self-> |
|
|
strict_error_checking |
|
|
) { |
|
|
my $version = $self-> |
|
|
xml_version |
|
|
; |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
if |
|
|
(defined $target) { |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
if |
|
|
(((not defined $version or $version eq '1.0') and |
|
|
not |
|
|
($target =~ /\A\p{InXML_NameStartChar10}\p{InXMLNameChar10}*\z/) |
|
|
) or |
|
|
(defined $version and $version eq '1.1' and |
|
|
not |
|
|
($target =~ /\A\p{InXMLNameStartChar11}\p{InXMLNameChar11}*\z/) |
|
|
)) { |
|
|
|
|
|
report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'INVALID_CHARACTER_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#MDOM_BAD_NAME', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#name' => $target, 'http://www.w3.org/2001/04/infoset#version' => $version, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2004/dom/main%23ensureXMLName+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => '$INPUT_PARAM_NAME'; |
|
|
|
|
|
; |
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
942 |
|
|
943 |
|
if ($$self->{manakai_is_html}) { |
944 |
; |
return 0; |
|
} |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
} |
|
|
|
|
|
my $bag = |
|
|
$self->{'b'} |
|
|
; |
|
|
$data = '' unless defined $data; |
|
|
my $stem; |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$stem = 'Message::DOM::XML::ManakaiDOMProcessingInstruction'->___create_node_stem ($bag, { |
|
|
|
|
|
'rc' |
|
|
=> 0, |
|
|
|
|
|
'id' |
|
|
=> \ |
|
|
( |
|
|
'tag:suika.fam.cx,2005-09:' . time . ':' . $$ . ':' . |
|
|
($Message::Util::ManakaiNode::UniqueIDR ||= |
|
|
[qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z |
|
|
a b c d e f g h i j k l m n o p q r s t u v w x y z |
|
|
0 1 2 3 4 5 6 7 8 9/]->[rand 62] . |
|
|
[qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z |
|
|
a b c d e f g h i j k l m n o p q r s t u v w x y z |
|
|
0 1 2 3 4 5 6 7 8 9/]->[rand 62] . |
|
|
[qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z |
|
|
a b c d e f g h i j k l m n o p q r s t u v w x y z |
|
|
0 1 2 3 4 5 6 7 8 9/]->[rand 62] . |
|
|
[qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z |
|
|
a b c d e f g h i j k l m n o p q r s t u v w x y z |
|
|
0 1 2 3 4 5 6 7 8 9/]->[rand 62] . |
|
|
[qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z |
|
|
a b c d e f g h i j k l m n o p q r s t u v w x y z |
|
|
0 1 2 3 4 5 6 7 8 9/]->[rand 62]) . |
|
|
(++$Message::Util::ManakaiNode::UniqueIDN) |
|
|
) |
|
|
, |
|
|
}, { |
|
|
'target' => \$target, |
|
|
'con' => \$data, |
|
|
'od' => $self, |
|
|
}); |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
if |
|
|
(defined 'Message::DOM::XML::ManakaiDOMProcessingInstruction') { |
|
|
if (ref 'Message::DOM::XML::ManakaiDOMProcessingInstruction' eq 'SCALAR') { |
|
|
$stem->{'cls'} = 'Message::DOM::XML::ManakaiDOMProcessingInstruction'; |
|
|
} elsif (defined $Message::Util::ManakaiStringRef::Value{'Message::DOM::XML::ManakaiDOMProcessingInstruction'}) { |
|
|
$stem->{'cls'} = $Message::Util::ManakaiStringRef::Value{'Message::DOM::XML::ManakaiDOMProcessingInstruction'}; |
|
945 |
} else { |
} else { |
946 |
require Scalar::Util; |
return $$self->{xml_standalone}; |
|
$stem->{'cls'} = $Message::Util::ManakaiStringRef::Value{'Message::DOM::XML::ManakaiDOMProcessingInstruction'} = \('Message::DOM::XML::ManakaiDOMProcessingInstruction'); |
|
|
Scalar::Util::weaken ($Message::Util::ManakaiStringRef::Value{'Message::DOM::XML::ManakaiDOMProcessingInstruction'}); |
|
947 |
} |
} |
948 |
} else { |
} # xml_standalone |
|
CORE::delete $stem->{'cls'}; |
|
|
} |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
$bag->{${$stem->{ |
|
|
'id' |
|
|
}}} = $stem; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$r = ${$stem->{ |
|
|
'cls' |
|
|
}}->___create_node_ref ({ |
|
|
|
|
|
'id' |
|
|
=> $stem->{ |
|
|
'id' |
|
|
}, |
|
|
|
|
|
'b' |
|
|
=> $bag, |
|
|
}, { |
|
|
}); |
|
|
$stem->{ |
|
|
'rc' |
|
|
}++; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
} |
|
|
$r} |
|
|
sub strict_error_checking ($;$) { |
|
|
if (@_ == 1) {my ($self) = @_; |
|
|
my $r = 0; |
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$r = $self->{ |
|
|
'b' |
|
|
}->{${$self->{ |
|
|
'id' |
|
|
}}} |
|
|
->{'chk'}; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
$r = |
|
|
1 unless |
|
|
defined $r; |
|
|
|
|
|
|
|
|
} |
|
|
$r; |
|
|
} else {my ($self, $given) = @_; |
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$self->{ |
|
|
'b' |
|
|
}->{${$self->{ |
|
|
'id' |
|
|
}}} |
|
|
->{'chk'} = $given ? 1 : 0; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
} |
|
|
} |
|
|
} |
|
|
sub dom_config ($;$) { |
|
|
if (@_ == 1) {my ($self) = @_; |
|
|
my $r; |
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$r = bless [$self, ($self->{'b'}->{${$self->{'id'}}}), 'Message::DOM::IFLatest::Document'], |
|
|
|
|
|
'Message::DOM::DOMCore::ManakaiDOMConfiguration' |
|
|
; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
} |
|
|
$r; |
|
|
} else {my ($self) = @_; |
|
|
report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Document::ManakaiDOMDocument', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'dom_config'; |
|
|
} |
|
|
} |
|
|
sub document_element ($;$) { |
|
|
if (@_ == 1) {my ($self) = @_; |
|
|
my $r; |
|
949 |
|
|
|
{ |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth + 1; |
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
F: |
|
|
for my $child (@{$self-> |
|
|
child_nodes |
|
|
}) { |
|
|
if ($child-> |
|
|
node_type |
|
|
== |
|
|
'1' |
|
|
) { |
|
|
$r = $child; |
|
|
last F; |
|
|
} |
|
|
} # F |
|
|
|
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
;} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
} |
|
|
$r; |
|
|
} else {my ($self) = @_; |
|
|
report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Document::ManakaiDOMDocument', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'document_element'; |
|
|
} |
|
|
} |
|
|
sub implementation ($;$) { |
|
|
if (@_ == 1) {my ($self) = @_; |
|
|
my $r; |
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
my |
|
|
$__v = $self->{ |
|
|
'b' |
|
|
}->{${$self->{ |
|
|
'id' |
|
|
}}} |
|
|
->{'impl'}; |
|
|
if (defined $__v) { |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$r = ${$self->{'b'}->{${$__v}}->{ |
|
|
'cls' |
|
|
}}->___create_node_ref ({ |
|
|
|
|
|
'id' |
|
|
=> $__v, |
|
|
|
|
|
'b' |
|
|
=> $self->{'b'}, |
|
|
}, { |
|
|
'nrifs' => ['Message::DOM::IFLatest::DOMImplementation'], |
|
|
}); |
|
|
$self->{'b'}->{${$__v}}->{ |
|
|
'rc' |
|
|
}++; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
} |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
} |
|
|
$r; |
|
|
} else {my ($self) = @_; |
|
|
report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Document::ManakaiDOMDocument', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'implementation'; |
|
|
} |
|
|
} |
|
950 |
sub xml_version ($;$) { |
sub xml_version ($;$) { |
951 |
if (@_ == 1) {my ($self) = @_; |
my $self = $_[0]; |
952 |
my $r = ''; |
if (@_ > 1) { |
953 |
|
my $v = ''.$_[1]; |
954 |
{ |
if ($$self->{strict_error_checking}) { |
955 |
|
if ($$self->{manakai_is_html}) { |
956 |
|
report Message::DOM::DOMException |
957 |
{ |
-object => $self, |
958 |
|
-type => 'NOT_SUPPORTED_ERR', |
959 |
|
-subtype => 'NON_HTML_OPERATION_ERR'; |
960 |
$r = $self->{ |
} |
961 |
'b' |
if ($v ne '1.0' and $v ne '1.1') { |
962 |
}->{${$self->{ |
report Message::DOM::DOMException |
963 |
'id' |
-object => $self, |
964 |
}}} |
-type => 'NOT_SUPPORTED_ERR', |
965 |
->{'http://www.w3.org/2001/04/infoset#version'}; |
-subtype => 'UNKNOWN_XML_VERSION_ERR'; |
966 |
|
} |
967 |
|
if ($$self->{manakai_read_only}) { |
968 |
} |
## ISSUE: Not in DOM3. |
969 |
|
report Message::DOM::DOMException |
970 |
; |
-object => $self, |
971 |
$r = '1.0' unless defined $r; |
-type => 'NO_MODIFICATION_ALLOWED_ERR', |
972 |
|
-subtype => 'READ_ONLY_NODE_ERR'; |
973 |
|
} |
974 |
} |
} |
975 |
$r; |
$$self->{xml_version} = $v; |
976 |
} else {my ($self, $given) = @_; |
} |
977 |
|
|
978 |
{ |
if (defined wantarray) { |
979 |
|
if ($$self->{manakai_is_html}) { |
980 |
|
return undef; |
981 |
{ |
} elsif (defined $$self->{xml_version}) { |
982 |
|
return $$self->{xml_version}; |
|
if |
|
|
($self-> |
|
|
manakai_read_only |
|
|
) { |
|
|
|
|
|
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'; |
|
|
|
|
|
; |
|
|
} |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
if (defined $given and |
|
|
($given eq '1.0' or $given eq '1.1' or |
|
|
not $self-> |
|
|
strict_error_checking |
|
|
)) { |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$self->{ |
|
|
'b' |
|
|
}->{${$self->{ |
|
|
'id' |
|
|
}}} |
|
|
->{'http://www.w3.org/2001/04/infoset#version'} = $given; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
} else { |
|
|
|
|
|
report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NOT_SUPPORTED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'set', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#MDOM_IMPL_NOSUPPORT_XMLVER', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Document::ManakaiDOMDocument', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'xml_version', 'http://www.w3.org/2001/04/infoset#version' => $given; |
|
|
|
|
|
; |
|
|
} |
|
|
|
|
|
|
|
|
} |
|
|
} |
|
|
} |
|
|
sub doctype ($;$) { |
|
|
if (@_ == 1) {my ($self) = @_; |
|
|
my $r; |
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth + 1; |
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
F: |
|
|
for my $child (@{$self-> |
|
|
child_nodes |
|
|
}) { |
|
|
my $nt = $child-> |
|
|
node_type |
|
|
; |
|
|
if ($nt == |
|
|
'10' |
|
|
) { |
|
|
$r = $child; |
|
|
last F; |
|
|
} elsif ($nt == |
|
|
'1' |
|
|
) { # document element |
|
|
last F; |
|
|
} |
|
|
} # F |
|
|
|
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
;} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
} |
|
|
$r; |
|
|
} else {my ($self) = @_; |
|
|
report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Document::ManakaiDOMDocument', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'doctype'; |
|
|
} |
|
|
} |
|
|
sub document_uri ($;$) { |
|
|
if (@_ == 1) {my ($self) = @_; |
|
|
my $r = ''; |
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$r = $self->{ |
|
|
'b' |
|
|
}->{${$self->{ |
|
|
'id' |
|
|
}}} |
|
|
->{'duri'}; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
} |
|
|
$r; |
|
|
} else {my ($self, $given) = @_; |
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
if |
|
|
($self-> |
|
|
manakai_read_only |
|
|
) { |
|
|
|
|
|
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'; |
|
|
|
|
|
; |
|
|
} |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$self->{ |
|
|
'b' |
|
|
}->{${$self->{ |
|
|
'id' |
|
|
}}} |
|
|
->{'duri'} = $given; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
} |
|
|
} |
|
|
} |
|
|
sub input_encoding ($;$) { |
|
|
if (@_ == 1) {my ($self) = @_; |
|
|
my $r = ''; |
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$r = $self->{ |
|
|
'b' |
|
|
}->{${$self->{ |
|
|
'id' |
|
|
}}} |
|
|
->{'ces'}; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
} |
|
|
$r; |
|
|
} else {my ($self, $given) = @_; |
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
if |
|
|
($self-> |
|
|
manakai_read_only |
|
|
) { |
|
|
|
|
|
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'; |
|
|
|
|
|
; |
|
|
} |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$self->{ |
|
|
'b' |
|
|
}->{${$self->{ |
|
|
'id' |
|
|
}}} |
|
|
->{'ces'} = $given; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
} |
|
|
} |
|
|
} |
|
|
sub xml_encoding ($;$) { |
|
|
if (@_ == 1) {my ($self) = @_; |
|
|
my $r = ''; |
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$r = $self->{ |
|
|
'b' |
|
|
}->{${$self->{ |
|
|
'id' |
|
|
}}} |
|
|
->{'xcs'}; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
} |
|
|
$r; |
|
|
} else {my ($self, $given) = @_; |
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
if |
|
|
($self-> |
|
|
manakai_read_only |
|
|
) { |
|
|
|
|
|
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'; |
|
|
|
|
|
; |
|
|
} |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$self->{ |
|
|
'b' |
|
|
}->{${$self->{ |
|
|
'id' |
|
|
}}} |
|
|
->{'xcs'} = $given; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
} |
|
|
} |
|
|
} |
|
|
sub xml_standalone ($;$) { |
|
|
if (@_ == 1) {my ($self) = @_; |
|
|
my $r = 0; |
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$r = $self->{ |
|
|
'b' |
|
|
}->{${$self->{ |
|
|
'id' |
|
|
}}} |
|
|
->{'http://www.w3.org/2001/04/infoset#standalone'}; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
} |
|
|
$r; |
|
|
} else {my ($self, $given) = @_; |
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
if |
|
|
($self-> |
|
|
manakai_read_only |
|
|
) { |
|
|
|
|
|
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'; |
|
|
|
|
|
; |
|
|
} |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$self->{ |
|
|
'b' |
|
|
}->{${$self->{ |
|
|
'id' |
|
|
}}} |
|
|
->{'http://www.w3.org/2001/04/infoset#standalone'} = $given; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
} |
|
|
} |
|
|
} |
|
|
sub adopt_node ($$) { |
|
|
my ($self, $source) = @_; |
|
|
my $r; |
|
|
|
|
|
{ |
|
|
|
|
|
ADOPT: |
|
|
{ |
|
|
last ADOPT |
|
|
unless $source->isa ( |
|
|
'Message::DOM::TreeCore::ManakaiDOMNode' |
|
|
) and |
|
|
|
|
|
$self->{'b'} |
|
|
eq |
|
|
|
|
|
$source->{'b'} |
|
|
; |
|
|
|
|
|
my $strict = $self-> |
|
|
strict_error_checking |
|
|
; |
|
|
if ($strict and $self-> |
|
|
manakai_read_only |
|
|
) { |
|
|
|
|
|
report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'adopt_node', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#NOMOD_THIS', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Document::ManakaiDOMDocument', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => 'source', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#node' => 'source'; |
|
|
|
|
|
; |
|
|
} |
|
|
my $parent = $source-> |
|
|
parent_node |
|
|
; |
|
|
if ($strict and defined $parent and |
|
|
$parent-> |
|
|
manakai_read_only |
|
|
) { |
|
|
|
|
|
report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'adopt_node', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#NOMOD_PARENT', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Document::ManakaiDOMDocument', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => 'source', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#node' => 'parent'; |
|
|
|
|
|
; |
|
|
} |
|
|
my $nt = $source-> |
|
|
node_type |
|
|
; |
|
|
my $oe; |
|
|
if ($nt == |
|
|
'2' |
|
|
) { |
|
|
$oe = $source-> |
|
|
owner_element |
|
|
; |
|
|
if ($strict and defined $oe and $oe-> |
|
|
manakai_read_only |
|
|
) { |
|
|
|
|
|
report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'adopt_node', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#NOMOD_PARENT', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Document::ManakaiDOMDocument', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => 'source', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#node' => 'oe'; |
|
|
|
|
|
; |
|
|
} |
|
|
} elsif ($nt == |
|
|
'9' or |
|
|
|
|
|
$nt == |
|
|
'10' or |
|
|
|
|
|
$nt == |
|
|
'6' or |
|
|
|
|
|
$nt == |
|
|
'12' |
|
|
) { |
|
|
|
|
|
report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NOT_SUPPORTED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'adopt_node', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#ADOPT_NODE_TYPE_NOT_SUPPORTED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Document::ManakaiDOMDocument', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => 'source', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#node' => 'source'; |
|
|
|
|
|
; |
|
|
} |
|
|
|
|
|
my @change_od; |
|
|
my @nodes = ($source); |
|
|
while (@nodes) { |
|
|
my $node = shift @nodes; |
|
|
my $nt = $node-> |
|
|
node_type |
|
|
; |
|
|
if ($strict and $node-> |
|
|
manakai_read_only |
|
|
) { |
|
|
|
|
|
report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'adopt_node', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#NOMOD_DESCENDANT_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Document::ManakaiDOMDocument', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => 'source', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#node' => $node; |
|
|
|
|
|
; |
|
|
} |
|
|
if ($nt == |
|
|
'1' |
|
|
) { |
|
|
push @change_od, $node; |
|
|
push @nodes, @{$node-> |
|
|
child_nodes |
|
|
}; |
|
|
my $attrs = $node-> |
|
|
attributes |
|
|
; |
|
|
my $attrsLength = $attrs-> |
|
|
length |
|
|
; |
|
|
for my $i (0..($attrsLength - 1)) { |
|
|
push @nodes, $attrs-> |
|
|
item |
|
|
($i); |
|
|
} |
|
|
} elsif ($nt == |
|
|
'2' or |
|
|
|
|
|
$nt == |
|
|
'5' or |
|
|
|
|
|
$nt == |
|
|
'11' |
|
|
) { |
|
|
push @change_od, $node; |
|
|
push @nodes, @{$node-> |
|
|
child_nodes |
|
|
}; |
|
|
} elsif ($nt == |
|
|
'3' or |
|
|
|
|
|
$nt == |
|
|
'8' or |
|
|
|
|
|
$nt == |
|
|
'7' or |
|
|
|
|
|
$nt == |
|
|
'4' |
|
|
) { |
|
|
push @change_od, $node; |
|
983 |
} else { |
} else { |
984 |
## TODO: assertion |
return '1.0'; |
|
} |
|
|
} # nodes |
|
|
|
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth + 1; |
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
if |
|
|
(defined $parent) { |
|
|
$parent-> |
|
|
remove_child |
|
|
($source); |
|
|
} elsif (defined $oe) { |
|
|
$oe-> |
|
|
remove_attribute_node |
|
|
($source); |
|
985 |
} |
} |
|
|
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
;} |
|
|
|
|
|
; |
|
|
|
|
|
$r = $source; |
|
|
my $old_od = $change_od[0]-> |
|
|
owner_document |
|
|
; |
|
|
## NOTE: The array must have more than zero |
|
|
## nodes by definition. In addition, |
|
|
## it cannot contain document or document |
|
|
## type nodes in current implementation. |
|
|
|
|
|
if ($old_od eq $self) { |
|
|
last ADOPT; |
|
986 |
} |
} |
987 |
|
} # xml_version |
988 |
|
|
989 |
my $old_od_list; |
## |Document| methods |
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$old_od_list = $old_od->{ |
|
|
'b' |
|
|
}->{${$old_od->{ |
|
|
'id' |
|
|
}}} |
|
|
->{'do'}; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
my $new_od_list; |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$new_od_list = $self->{ |
|
|
'b' |
|
|
}->{${$self->{ |
|
|
'id' |
|
|
}}} |
|
|
->{'do'}; |
|
|
|
|
990 |
|
|
|
} |
|
|
|
|
|
; |
|
|
for my $n (@change_od) { |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$n->{ |
|
|
'b' |
|
|
}->{${$n->{ |
|
|
'id' |
|
|
}}} |
|
|
->{'od'} = $self->{ |
|
|
'id' |
|
|
}; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
my $nid = |
|
|
$n->{'id'} |
|
|
; |
|
|
CORE::delete $old_od_list->{$$nid}; |
|
|
$new_od_list->{$$nid} = $nid; |
|
|
} |
|
|
|
|
|
for my $src (@change_od) { |
|
|
my $src_ud; |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$src_ud = $src->{ |
|
|
'b' |
|
|
}->{${$src->{ |
|
|
'id' |
|
|
}}} |
|
|
->{'ud'}; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
for my $key (keys %{$src_ud or {}}) { |
|
|
my $dh = $src_ud->{$key}->[1]; |
|
|
if ($dh) { |
|
|
$dh-> |
|
|
handle |
|
|
|
|
|
( |
|
|
'5' |
|
|
, |
|
|
$key, $src_ud->{$key}->[0], $src, |
|
|
undef |
|
|
); |
|
|
} |
|
|
} |
|
|
} |
|
|
} # ADOPT |
|
|
|
|
|
|
|
|
} |
|
|
$r} |
|
991 |
sub get_element_by_id ($$) { |
sub get_element_by_id ($$) { |
992 |
my ($self, $elementId) = @_; |
local $Error::Depth = $Error::Depth + 1; |
993 |
my $r; |
my @nodes = @{$_[0]->child_nodes}; |
|
|
|
|
{ |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth + 1; |
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
my |
|
|
@nodes = @{$self-> |
|
|
child_nodes |
|
|
}; |
|
994 |
N: while (@nodes) { |
N: while (@nodes) { |
995 |
my $node = shift @nodes; |
my $node = shift @nodes; |
996 |
next N unless $node-> |
next N unless $node->node_type == 1; # ELEMENT_NODE |
997 |
node_type |
for my $attr (@{$node->attributes}) { |
998 |
== |
if ($attr->is_id and $attr->value eq $_[1]) { |
999 |
'1' |
return $node; |
|
; |
|
|
for my $attr (@{$node-> |
|
|
attributes |
|
|
}) { |
|
|
if ($attr-> |
|
|
is_id and |
|
|
|
|
|
$attr-> |
|
|
value eq |
|
|
$elementId) { |
|
|
$r = $attr; |
|
|
last N; |
|
1000 |
} |
} |
1001 |
} |
} |
1002 |
unshift @nodes, @{$node-> |
unshift @nodes, @{$node->child_nodes}; |
|
child_nodes |
|
|
}; |
|
1003 |
} # N |
} # N |
1004 |
|
return undef; |
1005 |
|
} # get_element_by_id |
1006 |
|
|
1007 |
|
## TODO: HTML5 case normalization |
|
|
|
|
} |
|
|
|
|
|
|
|
|
;} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
} |
|
|
$r} |
|
1008 |
sub get_elements_by_tag_name ($$) { |
sub get_elements_by_tag_name ($$) { |
1009 |
my ($self, $name) = @_; |
my $name = ''.$_[1]; |
1010 |
my $r; |
my $chk; |
1011 |
|
if ($name eq '*') { |
1012 |
{ |
$chk = sub () { 1 }; |
|
|
|
|
|
|
|
$name = "$name"; |
|
|
my $chk; |
|
|
if ($name eq '*') { |
|
|
$chk = sub { |
|
|
1 |
|
|
}; |
|
|
} else { |
|
|
$chk = sub { |
|
|
my $node = shift; |
|
|
my $nodeName = $node-> |
|
|
node_name |
|
|
; |
|
|
($nodeName eq $name); |
|
|
}; |
|
|
} |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$r = bless \[$self, $chk], |
|
|
'Message::DOM::TreeCore::ManakaiDOMGetElementsNodeList' |
|
|
; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
} |
|
|
$r} |
|
|
sub get_elements_by_tag_name_ns ($$$) { |
|
|
my ($self, $namespaceURI, $localName) = @_; |
|
|
|
|
|
{ |
|
|
|
|
|
if |
|
|
(CORE::defined $namespaceURI and CORE::length $namespaceURI == 0) { |
|
|
|
|
|
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:1144080824:30455:ZO0D78781+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest'; |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$namespaceURI = undef; |
|
|
|
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
} |
|
|
|
|
|
|
|
|
} |
|
|
my $r; |
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$namespaceURI = "$namespaceURI" if defined $namespaceURI; |
|
|
$localName = "$localName"; |
|
|
my $chk; |
|
|
if (not defined $namespaceURI) { |
|
|
if ($localName eq '*') { |
|
|
$chk = sub { |
|
|
my $node = shift; |
|
|
(not defined $node-> |
|
|
namespace_uri |
|
|
); |
|
|
}; |
|
1013 |
} else { |
} else { |
1014 |
$chk = sub { |
$chk = sub ($) { |
1015 |
my $node = shift; |
return $_[0]->manakai_tag_name eq $name; |
|
(not defined $node-> |
|
|
namespace_uri and |
|
|
|
|
|
$node-> |
|
|
local_name eq |
|
|
$localName); |
|
1016 |
}; |
}; |
1017 |
} |
} |
|
} elsif ($namespaceURI eq '*') { |
|
|
if ($localName eq '*') { |
|
|
$chk = sub { |
|
|
1 |
|
|
}; |
|
|
} else { |
|
|
$chk = sub { |
|
|
my $node = shift; |
|
|
($node-> |
|
|
local_name eq |
|
|
$localName); |
|
|
}; |
|
|
} |
|
|
} else { |
|
|
if ($localName eq '*') { |
|
|
$chk = sub { |
|
|
my $node = shift; |
|
|
my $nsuri = $node-> |
|
|
namespace_uri |
|
|
; |
|
|
(defined $nsuri and $nsuri eq $namespaceURI); |
|
|
}; |
|
|
} else { |
|
|
$chk = sub { |
|
|
my $node = shift; |
|
|
my $nsuri = $node-> |
|
|
namespace_uri |
|
|
; |
|
|
(defined $nsuri and $nsuri eq $namespaceURI and |
|
|
$node-> |
|
|
local_name eq |
|
|
$localName); |
|
|
}; |
|
|
} |
|
|
} |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$r = bless \[$self, $chk], |
|
|
'Message::DOM::TreeCore::ManakaiDOMGetElementsNodeList' |
|
|
; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
} |
|
|
$r} |
|
|
sub import_node ($$;$) { |
|
|
my ($self, $importedNode, $deep) = @_; |
|
|
my $r; |
|
|
report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NOT_SUPPORTED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'import_node', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#MDOM_IMPL_METHOD_NOT_IMPLEMENTED', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Document::ManakaiDOMDocument'; |
|
|
$r} |
|
|
sub normalize_document ($) { |
|
|
my ($self) = @_; |
|
|
report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NOT_SUPPORTED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'normalize_document', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#MDOM_IMPL_METHOD_NOT_IMPLEMENTED', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Document::ManakaiDOMDocument'; |
|
|
} |
|
|
sub rename_node ($$$$) { |
|
|
my ($self, $n, $namespaceURI, $qualifiedName) = @_; |
|
|
|
|
|
{ |
|
|
|
|
|
if |
|
|
(CORE::defined $namespaceURI and CORE::length $namespaceURI == 0) { |
|
|
|
|
|
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:1144080824:30455:ZO0D78781+http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom%23ManakaiDOMLatest'; |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$namespaceURI = undef; |
|
|
|
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
} |
|
|
|
|
|
|
|
|
} |
|
|
my $r; |
|
|
report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NOT_SUPPORTED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'rename_node', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#MDOM_IMPL_METHOD_NOT_IMPLEMENTED', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Document::ManakaiDOMDocument'; |
|
|
$r} |
|
|
sub manakai_entity_base_uri ($;$) { |
|
|
if (@_ == 1) {my ($self) = @_; |
|
|
my $r = ''; |
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$r = $self->{ |
|
|
'b' |
|
|
}->{${$self->{ |
|
|
'id' |
|
|
}}} |
|
|
->{'buri'}; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
unless (defined $r) { |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$r = $self->{ |
|
|
'b' |
|
|
}->{${$self->{ |
|
|
'id' |
|
|
}}} |
|
|
->{'duri'}; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
} |
|
|
|
|
|
|
|
|
} |
|
|
$r; |
|
|
} else {my ($self, $given) = @_; |
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
if |
|
|
($self-> |
|
|
manakai_read_only |
|
|
) { |
|
|
|
|
|
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'; |
|
|
|
|
|
; |
|
|
} |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
1018 |
|
|
1019 |
$self->{ |
require Message::DOM::NodeList; |
1020 |
'b' |
return bless \[$_[0], $chk], 'Message::DOM::NodeList::GetElementsList'; |
1021 |
}->{${$self->{ |
} # get_elements_by_tag_name |
|
'id' |
|
|
}}} |
|
|
->{'buri'} = $given; |
|
1022 |
|
|
1023 |
|
sub get_elements_by_tag_name_ns ($$$) { |
1024 |
} |
my $nsuri = defined $_[1] ? ''.$_[1] : ''; |
1025 |
|
my $lname = ''.$_[2]; |
1026 |
; |
my $chk; |
1027 |
|
if ($nsuri eq '*') { |
1028 |
|
if ($lname eq '*') { |
1029 |
} |
$chk = sub () { 1 }; |
1030 |
} |
} else { |
1031 |
} |
$chk = sub ($) { |
1032 |
sub all_declarations_processed ($;$) { |
return $_[0]->manakai_local_name eq $lname; |
1033 |
if (@_ == 1) {my ($self) = @_; |
}; |
1034 |
my $r = 0; |
} |
1035 |
|
} elsif ($nsuri eq '') { |
1036 |
{ |
if ($lname eq '*') { |
1037 |
|
$chk = sub ($) { |
1038 |
|
return not defined $_[0]->namespace_uri; |
1039 |
{ |
}; |
1040 |
|
} else { |
1041 |
|
$chk = sub ($) { |
1042 |
$r = $self->{ |
return (not defined $_[0]->namespace_uri and |
1043 |
'b' |
$_[0]->manakai_local_name eq $lname); |
1044 |
}->{${$self->{ |
}; |
|
'id' |
|
|
}}} |
|
|
->{'http://www.w3.org/2001/04/infoset#allDeclarationsProcessed'}; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
} |
|
|
$r; |
|
|
} else {my ($self, $given) = @_; |
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
if |
|
|
($self-> |
|
|
manakai_read_only |
|
|
) { |
|
|
|
|
|
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'; |
|
|
|
|
|
; |
|
|
} |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$self->{ |
|
|
'b' |
|
|
}->{${$self->{ |
|
|
'id' |
|
|
}}} |
|
|
->{'http://www.w3.org/2001/04/infoset#allDeclarationsProcessed'} = $given; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
} |
|
|
} |
|
|
} |
|
|
$Message::DOM::DOMFeature::ClassInfo->{q<Message::DOM::Document::ManakaiDOMDocument>}->{has_feature} = {'core', |
|
|
{'', |
|
|
'1', |
|
|
'1.0', |
|
|
'1', |
|
|
'2.0', |
|
|
'1', |
|
|
'3.0', |
|
|
'1'}, |
|
|
'xml', |
|
|
{'', |
|
|
'1', |
|
|
'1.0', |
|
|
'1', |
|
|
'2.0', |
|
|
'1', |
|
|
'3.0', |
|
|
'1'}, |
|
|
'xmlversion', |
|
|
{'', |
|
|
'1', |
|
|
'1.0', |
|
|
'1', |
|
|
'1.1', |
|
|
'1'}}; |
|
|
$Message::DOM::ClassPoint{q<Message::DOM::Document::ManakaiDOMDocument>} = 14.1; |
|
|
$Message::DOM::DOMFeature::ClassInfo->{q<Message::DOM::Document::ManakaiDOMDocument>}->{compat_class}->{q<Message::DOM::Document::ManakaiDOMDocument>} = 1; |
|
|
$Message::Util::Grove::ClassProp{q<Message::DOM::Document::ManakaiDOMDocument>} = {'s1a', |
|
|
['child'], |
|
|
'v1h', |
|
|
['do'], |
|
|
'w0', |
|
|
['impl']}; |
|
|
package Message::DOM::IFLatest::DocumentFragment; |
|
|
our $VERSION = 20060404.0922; |
|
|
package Message::DOM::Document::ManakaiDOMDocumentFragment; |
|
|
our $VERSION = 20060404.0922; |
|
|
push our @ISA, 'Message::DOM::TreeCore::ManakaiDOMNode', |
|
|
'Message::DOM::IF::DocumentFragment', |
|
|
'Message::DOM::IF::Node', |
|
|
'Message::DOM::IFLatest::DocumentFragment', |
|
|
'Message::DOM::IFLatest::Node', |
|
|
'Message::DOM::IFLevel1::DocumentFragment', |
|
|
'Message::DOM::IFLevel1::Node', |
|
|
'Message::DOM::IFLevel2::DocumentFragment', |
|
|
'Message::DOM::IFLevel2::Node', |
|
|
'Message::DOM::IFLevel3::DocumentFragment', |
|
|
'Message::DOM::IFLevel3::Node'; |
|
|
sub ___create_node_stem ($$$$) { |
|
|
my ($self, $bag, $obj, $opt) = @_; |
|
|
my $r = {}; |
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$obj->{ |
|
|
'child' |
|
|
} = []; |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$obj->{'od'} = $opt->{'od'}->{ |
|
|
'id' |
|
|
}; |
|
|
$bag->{${$opt->{'od'}->{ |
|
|
'id' |
|
|
}}} |
|
|
->{'do'}->{${$obj->{ |
|
|
'id' |
|
|
}}} |
|
|
= $obj->{ |
|
|
'id' |
|
|
}; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
$r = $obj; |
|
|
|
|
|
|
|
|
} |
|
|
$r} |
|
|
sub node_type ($;$) { |
|
|
if (@_ == 1) {my ($self) = @_; |
|
|
my $r; |
|
|
$r = '11'; |
|
|
$r; |
|
|
} else {my ($self) = @_; |
|
|
report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Document::ManakaiDOMDocumentFragment', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'node_type'; |
|
|
} |
|
|
} |
|
|
sub append_child ($$) { |
|
|
my ($self, $newChild) = @_; |
|
|
my $r; |
|
|
|
|
|
{ |
|
|
|
|
|
if |
|
|
($self eq $newChild) { |
|
|
|
|
|
report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'HIERARCHY_REQUEST_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'append_child', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/dom/tree#HIERARCHY_DOCUMENT_FRAGMENT_ITSELF_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Document::ManakaiDOMDocumentFragment', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => 'newChild'; |
|
|
|
|
|
; |
|
|
} |
|
|
my $self_od = $self-> |
|
|
owner_document |
|
|
; |
|
|
my $child_od = $newChild-> |
|
|
owner_document |
|
|
; |
|
|
my $child_nt = $newChild-> |
|
|
node_type |
|
|
; |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth + 1; |
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
my |
|
|
$strict = $self_od-> |
|
|
strict_error_checking |
|
|
; |
|
|
|
|
|
## -- Node Type check |
|
|
my @new_child; |
|
|
if ({ |
|
|
'3' => 1, |
|
|
'5' => 1, |
|
|
'1' => 1, |
|
|
'7' => 1, |
|
|
'4' => 1, |
|
|
'8' => 1, |
|
|
}->{$child_nt}) { |
|
|
push @new_child, $newChild; |
|
|
} elsif ($child_nt == |
|
|
'11' |
|
|
) { |
|
|
for my $cn (@{$newChild-> |
|
|
child_nodes |
|
|
}) { |
|
|
unless ({ |
|
|
'3' => 1, |
|
|
'5' => 1, |
|
|
'1' => 1, |
|
|
'7' => 1, |
|
|
'4' => 1, |
|
|
'8' => 1, |
|
|
}->{$cn-> |
|
|
node_type |
|
|
}) { |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth - 1; |
|
|
|
|
|
{ |
|
|
|
|
|
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; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
;} |
|
|
|
|
|
; |
|
|
} |
|
|
push @new_child, $cn; |
|
1045 |
} |
} |
1046 |
} else { |
} else { |
1047 |
|
if ($lname eq '*') { |
1048 |
|
$chk = sub ($) { |
1049 |
{ |
my $ns = $_[0]->namespace_uri; |
1050 |
|
return (defined $ns and $ns eq $nsuri); |
1051 |
local $Error::Depth = $Error::Depth - 1; |
}; |
1052 |
|
} else { |
1053 |
{ |
$chk = sub ($) { |
1054 |
|
my $ns = $_[0]->namespace_uri; |
1055 |
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; |
return (defined $ns and $ns eq $nsuri and |
1056 |
|
$_[0]->manakai_local_name eq $lname); |
1057 |
|
}; |
|
} |
|
|
|
|
|
|
|
|
;} |
|
|
|
|
|
; |
|
|
} |
|
|
|
|
|
my $nc_parent = @new_child ? $new_child[0]-> |
|
|
parent_node |
|
|
: |
|
|
|
|
|
undef |
|
|
; |
|
|
if ($strict) { |
|
|
## -- Wrong-document check |
|
|
unless ($self_od eq $child_od) { |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth - 1; |
|
|
|
|
|
{ |
|
|
|
|
|
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; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
;} |
|
|
|
|
|
; |
|
|
} |
|
|
|
|
|
## -- Read-onlyness check |
|
|
if ($self-> |
|
|
manakai_read_only |
|
|
) { |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth - 1; |
|
|
|
|
|
{ |
|
|
|
|
|
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'; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
;} |
|
|
|
|
|
; |
|
|
} |
|
|
if (@new_child) { |
|
|
if ($nc_parent and |
|
|
$nc_parent-> |
|
|
manakai_read_only |
|
|
) { |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth - 1; |
|
|
|
|
|
{ |
|
|
|
|
|
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'; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
;} |
|
|
|
|
|
; |
|
|
} |
|
1058 |
} |
} |
1059 |
} |
} |
1060 |
|
|
1061 |
## -- Insert at... |
require Message::DOM::NodeList; |
1062 |
my $index = -1; # last |
return bless \[$_[0], $chk], 'Message::DOM::NodeList::GetElementsList'; |
1063 |
|
} # get_elements_by_tag_name |
1064 |
|
|
1065 |
; # FOR !tc:ForAppendChild |
## TODO: import_node |
1066 |
|
|
1067 |
## -- Removes from parent |
## TODO: normalize_document |
|
if ($nc_parent) { |
|
|
if ($child_nt == |
|
|
'11' |
|
|
) { |
|
|
|
|
1068 |
|
|
1069 |
{ |
## TODO: rename_node |
1070 |
|
|
1071 |
|
## |DocumentTraversal| methods |
1072 |
|
|
1073 |
$newChild->{ |
## TODO: create_node_iterator |
|
'b' |
|
|
}->{${$newChild->{ |
|
|
'id' |
|
|
}}} |
|
|
->{'child'} = []; |
|
1074 |
|
|
1075 |
|
sub manakai_create_serial_walker ($$;$$$); |
1076 |
|
|
1077 |
} |
sub create_tree_walker ($$;$$$); |
1078 |
|
|
1079 |
; |
## |HTMLDocument| attributes |
|
} else { |
|
|
my $v; |
|
|
|
|
1080 |
|
|
1081 |
{ |
sub compat_mode ($) { |
1082 |
|
if (${$_[0]}->{manakai_is_html}) { |
1083 |
|
if (defined ${$_[0]}->{manakai_compat_mode} and |
1084 |
$v = $nc_parent->{ |
${$_[0]}->{manakai_compat_mode} eq 'quirks') { |
1085 |
'b' |
return 'BackCompat'; |
|
}->{${$nc_parent->{ |
|
|
'id' |
|
|
}}} |
|
|
->{'child'}; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
RP: for my $i (0..$#$v) { |
|
|
my $nodeid = $v->[$i]; |
|
|
if ( |
|
|
(${$new_child[0]->{'id'}} eq ${$nodeid}) |
|
|
) { |
|
|
splice @$v, $i, 1, (); |
|
|
last RP; |
|
|
} |
|
|
} # RP |
|
1086 |
} |
} |
1087 |
} |
} |
1088 |
|
return 'CSS1Compat'; |
1089 |
|
} # compat_mode |
1090 |
|
|
1091 |
## -- Rewrite the |parentNode| properties |
sub manakai_compat_mode ($;$) { |
1092 |
for my $nc (@new_child) { |
if (${$_[0]}->{manakai_is_html}) { |
1093 |
|
if (@_ > 1 and defined $_[1] and |
1094 |
|
{'no quirks' => 1, 'limited quirks' => 1, 'quirks' => 1}->{$_[1]}) { |
1095 |
{ |
${$_[0]}->{manakai_compat_mode} = $_[1]; |
|
|
|
|
|
|
|
$nc->{ |
|
|
'b' |
|
|
}->{${$nc->{ |
|
|
'id' |
|
|
}}} |
|
|
->{'parent'} = $self->{ |
|
|
'id' |
|
|
}; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
} |
|
|
|
|
|
my $children; |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$children = $self->{ |
|
|
'b' |
|
|
}->{${$self->{ |
|
|
'id' |
|
|
}}} |
|
|
->{'child'}; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
## -- Adds to children list |
|
|
push @$children, map { |
|
|
|
|
|
$_->{'id'} |
|
|
|
|
|
} @new_child; |
|
|
$r = $newChild; |
|
|
|
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
;} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
} |
|
|
$r} |
|
|
sub insert_before ($$;$) { |
|
|
my ($self, $newChild, $refChild) = @_; |
|
|
my $r; |
|
|
|
|
|
{ |
|
|
|
|
|
if |
|
|
($self eq $newChild) { |
|
|
|
|
|
report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'HIERARCHY_REQUEST_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'insert_before', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/dom/tree#HIERARCHY_DOCUMENT_FRAGMENT_ITSELF_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Document::ManakaiDOMDocumentFragment', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => 'newChild'; |
|
|
|
|
|
; |
|
|
} |
|
|
my $self_od = $self-> |
|
|
owner_document |
|
|
; |
|
|
my $child_od = $newChild-> |
|
|
owner_document |
|
|
; |
|
|
my $child_nt = $newChild-> |
|
|
node_type |
|
|
; |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth + 1; |
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
my |
|
|
$strict = $self_od-> |
|
|
strict_error_checking |
|
|
; |
|
|
|
|
|
## -- Node Type check |
|
|
my @new_child; |
|
|
if ({ |
|
|
'3' => 1, |
|
|
'5' => 1, |
|
|
'1' => 1, |
|
|
'7' => 1, |
|
|
'4' => 1, |
|
|
'8' => 1, |
|
|
}->{$child_nt}) { |
|
|
push @new_child, $newChild; |
|
|
} elsif ($child_nt == |
|
|
'11' |
|
|
) { |
|
|
for my $cn (@{$newChild-> |
|
|
child_nodes |
|
|
}) { |
|
|
unless ({ |
|
|
'3' => 1, |
|
|
'5' => 1, |
|
|
'1' => 1, |
|
|
'7' => 1, |
|
|
'4' => 1, |
|
|
'8' => 1, |
|
|
}->{$cn-> |
|
|
node_type |
|
|
}) { |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth - 1; |
|
|
|
|
|
{ |
|
|
|
|
|
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; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
;} |
|
|
|
|
|
; |
|
|
} |
|
|
push @new_child, $cn; |
|
1096 |
} |
} |
1097 |
|
return ${$_[0]}->{manakai_compat_mode} || 'no quirks'; |
1098 |
} else { |
} else { |
1099 |
|
return 'no quirks'; |
|
|
|
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth - 1; |
|
|
|
|
|
{ |
|
|
|
|
|
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; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
;} |
|
|
|
|
|
; |
|
1100 |
} |
} |
1101 |
|
} # manakai_compat_mode |
1102 |
|
|
1103 |
my $nc_parent = @new_child ? $new_child[0]-> |
sub inner_html ($;$) { |
1104 |
parent_node |
my $self = $_[0]; |
1105 |
: |
local $Error::Depth = $Error::Depth + 1; |
1106 |
|
|
1107 |
undef |
if ($$self->{manakai_is_html}) { |
1108 |
; |
require Whatpm::HTML; |
1109 |
if ($strict) { |
if (@_ > 1) { |
1110 |
## -- Wrong-document check |
## Step 1 |
1111 |
unless ($self_od eq $child_od) { |
## TODO: Stop parsing and ... |
1112 |
|
|
1113 |
|
## Step 2 |
1114 |
|
my @cn = @{$self->child_nodes}; |
1115 |
|
for (@cn) { ## NOTE: Might throw a |NO_MODIFICATION_ALLOWED_ERR|. |
1116 |
|
$self->remove_child ($_); # |
1117 |
|
} |
1118 |
|
|
1119 |
{ |
## Step 3, 4, 5 |
1120 |
|
Whatpm::HTML->parse_string ($_[1] => $self); |
|
local $Error::Depth = $Error::Depth - 1; |
|
|
|
|
|
{ |
|
|
|
|
|
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; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
1121 |
|
|
1122 |
;} |
## TODO: |
1123 |
|
## <script>var input = function_to_do_xmlhttprequest (location.href); |
1124 |
|
## document.innerHTML = input</script> |
1125 |
|
|
1126 |
; |
return unless defined wantarray; |
1127 |
} |
} |
1128 |
|
|
1129 |
## -- Read-onlyness check |
return ${ Whatpm::HTML->get_inner_html ($self) }; |
1130 |
if ($self-> |
} else { |
1131 |
manakai_read_only |
if (@_ > 1) { |
1132 |
) { |
## Step 1 |
1133 |
|
require Whatpm::XMLParser; # MUST |
1134 |
|
my $doc = $self->implementation->create_document; |
1135 |
|
|
1136 |
|
## Step 2 |
1137 |
|
# |
1138 |
|
|
1139 |
{ |
## Step 3 |
1140 |
|
$doc = Whatpm::XMLParser->parse_string ($_[1] => $doc); # MUST |
|
local $Error::Depth = $Error::Depth - 1; |
|
|
|
|
|
{ |
|
|
|
|
|
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'; |
|
|
|
|
1141 |
|
|
1142 |
} |
## Step 4 |
1143 |
|
# |
1144 |
|
|
1145 |
|
## Step 5 |
1146 |
|
## TODO: ill-formed -> SYNTAX_ERR # MUST |
1147 |
|
|
1148 |
;} |
## Step 6 # MUST |
1149 |
|
my @cn = @{$self->child_nodes}; ## TODO: If read-only |
1150 |
; |
for (@cn) { |
1151 |
} |
$self->remove_child ($_); |
|
if (@new_child) { |
|
|
if ($nc_parent and |
|
|
$nc_parent-> |
|
|
manakai_read_only |
|
|
) { |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth - 1; |
|
|
|
|
|
{ |
|
|
|
|
|
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'; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
;} |
|
|
|
|
|
; |
|
1152 |
} |
} |
|
} |
|
|
} |
|
|
|
|
|
## -- Insert at... |
|
|
my $index = -1; # last |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
# tc:ForAppendChild & tc:ForReplaceChild |
|
|
if (defined $refChild) { |
|
|
if ($refChild eq $newChild) { |
|
|
|
|
1153 |
|
|
1154 |
{ |
## Step 7, 8, 9, 10 |
1155 |
|
for my $node (@{$doc->child_nodes}) { |
1156 |
|
$self->append_child ($self->adopt_node ($node)); |
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth - 1; |
|
|
|
|
|
{ |
|
|
|
|
|
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'; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
;} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
; |
|
1157 |
} |
} |
1158 |
|
|
1159 |
my $cns = $self-> |
return unless defined wantarray; |
|
child_nodes |
|
|
; |
|
|
my $cnsl = @$cns; |
|
|
C: { |
|
|
$index = 0; |
|
|
for my $i (0..($cnsl-1)) { |
|
|
my $cn = $cns->[$i]; |
|
|
if ($cn eq $refChild) { |
|
|
$index += $i; |
|
|
last C; |
|
|
} elsif ($cn eq $newChild) { |
|
|
$index = -1; # offset |
|
|
} |
|
|
} |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth - 1; |
|
|
|
|
|
{ |
|
|
|
|
|
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; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
;} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
; |
|
|
} # C |
|
|
} else { # |oldChild| is not defined |
|
|
|
|
|
|
|
|
; |
|
1160 |
} |
} |
|
|
|
|
|
|
1161 |
|
|
1162 |
} |
## TODO: This serializer is currently not conformant to HTML5 spec. |
1163 |
|
require Whatpm::XMLSerializer; |
1164 |
; # FOR !tc:ForAppendChild |
my $r = ''; |
1165 |
|
for (@{$self->child_nodes}) { |
1166 |
## -- Removes from parent |
$r .= ${ Whatpm::XMLSerializer->get_outer_xml ($_, sub { |
1167 |
if ($nc_parent) { |
## TODO: INVALID_STATE_ERR |
1168 |
if ($child_nt == |
}) }; |
|
'11' |
|
|
) { |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$newChild->{ |
|
|
'b' |
|
|
}->{${$newChild->{ |
|
|
'id' |
|
|
}}} |
|
|
->{'child'} = []; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
} else { |
|
|
my $v; |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$v = $nc_parent->{ |
|
|
'b' |
|
|
}->{${$nc_parent->{ |
|
|
'id' |
|
|
}}} |
|
|
->{'child'}; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
RP: for my $i (0..$#$v) { |
|
|
my $nodeid = $v->[$i]; |
|
|
if ( |
|
|
(${$new_child[0]->{'id'}} eq ${$nodeid}) |
|
|
) { |
|
|
splice @$v, $i, 1, (); |
|
|
last RP; |
|
|
} |
|
|
} # RP |
|
1169 |
} |
} |
1170 |
|
return $r; |
1171 |
} |
} |
1172 |
|
} # inner_html |
1173 |
|
|
1174 |
## -- Rewrite the |parentNode| properties |
sub manakai_is_html ($;$) { |
1175 |
for my $nc (@new_child) { |
if (@_ > 1) { |
1176 |
|
if ($_[1]) { |
1177 |
|
${$_[0]}->{manakai_is_html} = 1; |
|
{ |
|
|
|
|
|
|
|
|
$nc->{ |
|
|
'b' |
|
|
}->{${$nc->{ |
|
|
'id' |
|
|
}}} |
|
|
->{'parent'} = $self->{ |
|
|
'id' |
|
|
}; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
} |
|
|
|
|
|
my $children; |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$children = $self->{ |
|
|
'b' |
|
|
}->{${$self->{ |
|
|
'id' |
|
|
}}} |
|
|
->{'child'}; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
## -- Adds to children list |
|
|
if ($index == -1) { |
|
|
push @$children, map { |
|
|
|
|
|
$_->{'id'} |
|
|
|
|
|
} @new_child; |
|
1178 |
} else { |
} else { |
1179 |
splice @$children, $index, 0, map { |
delete ${$_[0]}->{manakai_is_html}; |
1180 |
|
delete ${$_[0]}->{manakai_compat_mode}; |
|
$_->{'id'} |
|
|
|
|
|
} @new_child; |
|
1181 |
} |
} |
|
$r = $newChild; |
|
|
|
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
;} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
} |
|
|
$r} |
|
|
sub replace_child ($$$) { |
|
|
my ($self, $newChild, $oldChild) = @_; |
|
|
my $r; |
|
|
|
|
|
{ |
|
|
|
|
|
if |
|
|
($self eq $newChild) { |
|
|
|
|
|
report Message::DOM::DOMCore::ManakaiDOMException -object => $self, '-type' => 'HIERARCHY_REQUEST_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'replace_child', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/dom/tree#HIERARCHY_DOCUMENT_FRAGMENT_ITSELF_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Document::ManakaiDOMDocumentFragment', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => 'newChild'; |
|
|
|
|
|
; |
|
|
} |
|
|
my $self_od = $self-> |
|
|
owner_document |
|
|
; |
|
|
my $child_od = $newChild-> |
|
|
owner_document |
|
|
; |
|
|
my $child_nt = $newChild-> |
|
|
node_type |
|
|
; |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth + 1; |
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
my |
|
|
$strict = $self_od-> |
|
|
strict_error_checking |
|
|
; |
|
|
|
|
|
## -- Node Type check |
|
|
my @new_child; |
|
|
if ({ |
|
|
'3' => 1, |
|
|
'5' => 1, |
|
|
'1' => 1, |
|
|
'7' => 1, |
|
|
'4' => 1, |
|
|
'8' => 1, |
|
|
}->{$child_nt}) { |
|
|
push @new_child, $newChild; |
|
|
} elsif ($child_nt == |
|
|
'11' |
|
|
) { |
|
|
for my $cn (@{$newChild-> |
|
|
child_nodes |
|
|
}) { |
|
|
unless ({ |
|
|
'3' => 1, |
|
|
'5' => 1, |
|
|
'1' => 1, |
|
|
'7' => 1, |
|
|
'4' => 1, |
|
|
'8' => 1, |
|
|
}->{$cn-> |
|
|
node_type |
|
|
}) { |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth - 1; |
|
|
|
|
|
{ |
|
|
|
|
|
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; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
;} |
|
|
|
|
|
; |
|
|
} |
|
|
push @new_child, $cn; |
|
|
} |
|
|
} else { |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth - 1; |
|
|
|
|
|
{ |
|
|
|
|
|
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; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
;} |
|
|
|
|
|
; |
|
1182 |
} |
} |
1183 |
|
return ${$_[0]}->{manakai_is_html}; |
1184 |
|
} # manakai_is_html |
1185 |
|
|
1186 |
my $nc_parent = @new_child ? $new_child[0]-> |
package Message::IF::Document; |
1187 |
parent_node |
package Message::IF::DocumentTraversal; |
1188 |
: |
package Message::IF::DocumentXDoctype; |
1189 |
|
package Message::IF::DocumentSelector; |
1190 |
undef |
package Message::IF::HTMLDocument; |
|
; |
|
|
if ($strict) { |
|
|
## -- Wrong-document check |
|
|
unless ($self_od eq $child_od) { |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth - 1; |
|
|
|
|
|
{ |
|
|
|
|
|
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; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
;} |
|
|
|
|
|
; |
|
|
} |
|
|
|
|
|
## -- Read-onlyness check |
|
|
if ($self-> |
|
|
manakai_read_only |
|
|
) { |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth - 1; |
|
|
|
|
|
{ |
|
|
|
|
|
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'; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
1191 |
|
|
1192 |
;} |
package Message::DOM::DOMImplementation; |
1193 |
|
|
1194 |
; |
sub create_document ($;$$$) { |
1195 |
} |
my $r = Message::DOM::Document->____new ($_[0]); |
|
if (@new_child) { |
|
|
if ($nc_parent and |
|
|
$nc_parent-> |
|
|
manakai_read_only |
|
|
) { |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth - 1; |
|
|
|
|
|
{ |
|
|
|
|
|
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'; |
|
1196 |
|
|
1197 |
|
if (defined $_[2]) { |
1198 |
} |
local $Error::Depth = $Error::Depth + 1; |
1199 |
|
$r->append_child ($r->create_element_ns ($_[1], $_[2])); # NAMESPACE_ERR |
1200 |
|
## NOTE: manakai might raise DOMExceptions in cases not defined |
1201 |
;} |
## in DOM3Core spec: XMLNSPREFIX_NONXMLNSNS_ERR, |
1202 |
|
## XMLNS_NONXMLNSNS_ERR, and NONXMLNSPREFIX_XMLNSNS_ERR. |
1203 |
; |
} elsif (defined $_[1]) { |
1204 |
} |
report Message::DOM::DOMException |
1205 |
} |
-object => $_[0], |
1206 |
|
-type => 'NAMESPACE_ERR', |
1207 |
|
-subtype => 'QNAME_NULLNS_ERR'; |
1208 |
} |
} |
1209 |
|
|
1210 |
## -- Insert at... |
if (defined $_[3]) { |
1211 |
my $index = -1; # last |
if ($_[3]->parent_node) { |
1212 |
|
report Message::DOM::DOMException |
1213 |
|
-object => $_[0], |
1214 |
{ |
-type => 'WRONG_DOCUMENT_ERR', |
1215 |
|
-subtype => 'INUSE_DOCTYPE_ERR'; |
|
|
|
|
# tc:ForAppendChild & tc:ForReplaceChild |
|
|
if (defined $oldChild) { |
|
|
if ($oldChild eq $newChild) { |
|
|
|
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth - 1; |
|
|
|
|
|
{ |
|
|
|
|
|
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'; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
;} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
} |
|
|
|
|
|
my $cns = $self-> |
|
|
child_nodes |
|
|
; |
|
|
my $cnsl = @$cns; |
|
|
C: { |
|
|
$index = 0; |
|
|
for my $i (0..($cnsl-1)) { |
|
|
my $cn = $cns->[$i]; |
|
|
if ($cn eq $oldChild) { |
|
|
$index += $i; |
|
|
last C; |
|
|
} elsif ($cn eq $newChild) { |
|
|
$index = -1; # offset |
|
|
} |
|
|
} |
|
|
|
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth - 1; |
|
|
|
|
|
{ |
|
|
|
|
|
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; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
;} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
} # C |
|
|
} else { # |oldChild| is not defined |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth - 1; |
|
|
|
|
|
{ |
|
|
|
|
|
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; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
;} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; # FOR !tc:ForAppendChild |
|
|
|
|
|
## -- Removes from parent |
|
|
if ($nc_parent) { |
|
|
if ($child_nt == |
|
|
'11' |
|
|
) { |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$newChild->{ |
|
|
'b' |
|
|
}->{${$newChild->{ |
|
|
'id' |
|
|
}}} |
|
|
->{'child'} = []; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
} else { |
|
|
my $v; |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$v = $nc_parent->{ |
|
|
'b' |
|
|
}->{${$nc_parent->{ |
|
|
'id' |
|
|
}}} |
|
|
->{'child'}; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
RP: for my $i (0..$#$v) { |
|
|
my $nodeid = $v->[$i]; |
|
|
if ( |
|
|
(${$new_child[0]->{'id'}} eq ${$nodeid}) |
|
|
) { |
|
|
splice @$v, $i, 1, (); |
|
|
last RP; |
|
|
} |
|
|
} # RP |
|
1216 |
} |
} |
1217 |
|
local $Error::Depth = $Error::Depth + 1; |
1218 |
|
$r->insert_before ($_[3], $r->first_child); # EXTERNAL_OBJECT_ERR |
1219 |
} |
} |
1220 |
|
|
1221 |
## -- Rewrite the |parentNode| properties |
return $r; |
1222 |
for my $nc (@new_child) { |
} # create_document |
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$nc->{ |
|
|
'b' |
|
|
}->{${$nc->{ |
|
|
'id' |
|
|
}}} |
|
|
->{'parent'} = $self->{ |
|
|
'id' |
|
|
}; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
} |
|
|
|
|
|
my $children; |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$children = $self->{ |
|
|
'b' |
|
|
}->{${$self->{ |
|
|
'id' |
|
|
}}} |
|
|
->{'child'}; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
## -- Replaces the node |
|
|
splice @$children, $index, 1, map { |
|
|
|
|
|
$_->{'id'} |
|
|
|
|
|
} @new_child; |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
CORE::delete |
|
|
$oldChild->{ |
|
|
'b' |
|
|
}->{${$oldChild->{ |
|
|
'id' |
|
|
}}} |
|
|
->{'parent'}; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
$r = $oldChild; |
|
|
|
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
;} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
} |
|
|
$r} |
|
|
sub node_name ($;$) { |
|
|
if (@_ == 1) {my ($self) = @_; |
|
|
my $r = ''; |
|
|
$r = '#document-fragment'; |
|
|
$r; |
|
|
} else {my ($self) = @_; |
|
|
report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Document::ManakaiDOMDocumentFragment', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'node_name'; |
|
|
} |
|
|
} |
|
|
sub manakai_append_text ($$) { |
|
|
my ($self, $string) = @_; |
|
|
my $r; |
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth + 1; |
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
my |
|
|
$lc = $self-> |
|
|
last_child |
|
|
; |
|
|
if (defined $lc and |
|
|
$lc-> |
|
|
node_type |
|
|
== |
|
|
'3' |
|
|
) { |
|
|
$lc-> |
|
|
manakai_append_text |
|
|
|
|
|
(ref $string eq 'SCALAR' ? $string : \$string); |
|
|
} else { |
|
|
my $text = $self-> |
|
|
owner_document |
|
|
|
|
|
-> |
|
|
create_text_node |
|
|
|
|
|
(ref $string eq 'SCALAR' ? $$string : $string); |
|
|
$self-> |
|
|
append_child |
|
|
($text); |
|
|
} |
|
|
$r = $self; |
|
|
|
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
;} |
|
|
|
|
|
; |
|
|
|
|
|
|
|
|
} |
|
|
$r} |
|
|
sub get_feature ($$$) { |
|
|
my ($self, $feature, $version) = @_; |
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$feature = lc $feature; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$version = '' unless defined $version; |
|
|
|
|
|
|
|
|
} |
|
|
my $r; |
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$feature =~ s/^\+//; |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
if |
|
|
($Message::DOM::DOMFeature::ClassInfo->{ref $self} |
|
|
->{has_feature}->{$feature}->{$version}) { |
|
|
$r = $self; |
|
|
} else { |
|
|
CLASS: for my $__class (sort { |
|
|
$Message::DOM::ClassPoint{$b} <=> $Message::DOM::ClassPoint{$a} |
|
|
} grep { |
|
|
$Message::DOM::DOMFeature::ClassInfo->{'Message::DOM::Document::ManakaiDOMDocumentFragment'} |
|
|
->{compat_class}->{$_} |
|
|
} keys %{$Message::DOM::DOMFeature::ClassInfo->{'Message::DOM::Document::ManakaiDOMDocumentFragment'} |
|
|
->{compat_class} or {}}) { |
|
|
if ($Message::DOM::DOMFeature::ClassInfo->{$__class} |
|
|
->{has_feature}->{$feature}->{$version}) { |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
$r = ${($self->{'b'})->{${($self->{'id'})}}->{ |
|
|
'cls' |
|
|
}}->___create_node_ref ({ |
|
|
|
|
|
'id' |
|
|
=> ($self->{'id'}), |
|
|
|
|
|
'b' |
|
|
=> ($self->{'b'}), |
|
|
}, { |
|
|
'nrcls' => \$__class, |
|
|
}); |
|
|
($self->{'b'})->{${($self->{'id'})}}->{ |
|
|
'rc' |
|
|
}++; |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
last CLASS; |
|
|
} |
|
|
} # CLASS |
|
|
} |
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
; |
|
|
unless (defined $r) { |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth + 1; |
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
|
|
|
$r = $self->SUPER::get_feature ($feature, $version); |
|
|
|
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
;} |
|
|
|
|
|
; |
|
|
} |
|
|
|
|
|
|
|
|
} |
|
|
$r} |
|
|
sub base_uri ($;$) { |
|
|
if (@_ == 1) {my ($self) = @_; |
|
|
my $r = ''; |
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
{ |
|
|
|
|
|
local $Error::Depth = $Error::Depth + 1; |
|
|
|
|
|
{ |
|
|
|
|
|
|
|
|
|
|
|
$r = $self-> |
|
|
owner_document |
|
|
-> |
|
|
base_uri |
|
|
; |
|
|
|
|
|
|
|
|
|
|
|
} |
|
1223 |
|
|
1224 |
|
=head1 LICENSE |
1225 |
|
|
1226 |
;} |
Copyright 2007 Wakaba <w@suika.fam.cx> |
1227 |
|
|
1228 |
; |
This program is free software; you can redistribute it and/or |
1229 |
|
modify it under the same terms as Perl itself. |
1230 |
|
|
1231 |
|
=cut |
1232 |
|
|
|
} |
|
|
$r; |
|
|
} else {my ($self) = @_; |
|
|
report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::DOM::Document::ManakaiDOMDocumentFragment', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'base_uri'; |
|
|
} |
|
|
} |
|
|
$Message::DOM::DOMFeature::ClassInfo->{q<Message::DOM::Document::ManakaiDOMDocumentFragment>}->{has_feature} = {'core', |
|
|
{'', |
|
|
'1', |
|
|
'1.0', |
|
|
'1', |
|
|
'2.0', |
|
|
'1', |
|
|
'3.0', |
|
|
'1'}, |
|
|
'xml', |
|
|
{'', |
|
|
'1', |
|
|
'1.0', |
|
|
'1', |
|
|
'2.0', |
|
|
'1', |
|
|
'3.0', |
|
|
'1'}, |
|
|
'xmlversion', |
|
|
{'', |
|
|
'1', |
|
|
'1.0', |
|
|
'1', |
|
|
'1.1', |
|
|
'1'}}; |
|
|
$Message::DOM::ClassPoint{q<Message::DOM::Document::ManakaiDOMDocumentFragment>} = 14.1; |
|
|
$Message::DOM::DOMFeature::ClassInfo->{q<Message::DOM::Document::ManakaiDOMDocumentFragment>}->{compat_class}->{q<Message::DOM::Document::ManakaiDOMDocumentFragment>} = 1; |
|
|
$Message::Util::Grove::ClassProp{q<Message::DOM::Document::ManakaiDOMDocumentFragment>} = {'s1a', |
|
|
['child'], |
|
|
'w0', |
|
|
['od']}; |
|
|
for ($Message::DOM::IF::Document::, $Message::DOM::IF::DocumentFragment::, $Message::DOM::IF::Node::, $Message::DOM::IFLatest::Node::, $Message::DOM::IFLevel1::Document::, $Message::DOM::IFLevel1::DocumentFragment::, $Message::DOM::IFLevel1::Node::, $Message::DOM::IFLevel2::Document::, $Message::DOM::IFLevel2::DocumentFragment::, $Message::DOM::IFLevel2::Node::, $Message::DOM::IFLevel3::Document::, $Message::DOM::IFLevel3::DocumentFragment::, $Message::DOM::IFLevel3::Node::){} |
|
|
## License: <http://suika.fam.cx/~wakaba/archive/2004/8/18/license#Perl+MPL> |
|
1233 |
1; |
1; |
1234 |
|
## $Date$ |