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