use
vars
qw( $VERSION @ISA @EXPORT
$IgnoreReadOnly $SafeMode $TagStyle
%DefaultEntities %DecodeDefaultEntity
)
;
BEGIN
{
$VERSION
=
'1.46'
;
my
$needVersion
=
'2.28'
;
die
"need at least XML::Parser version $needVersion (current=${XML::Parser::VERSION})"
unless
$XML::Parser::VERSION
>=
$needVersion
;
@ISA
=
qw( Exporter )
;
@EXPORT
=
qw(
UNKNOWN_NODE
ELEMENT_NODE
ATTRIBUTE_NODE
TEXT_NODE
CDATA_SECTION_NODE
ENTITY_REFERENCE_NODE
ENTITY_NODE
PROCESSING_INSTRUCTION_NODE
COMMENT_NODE
DOCUMENT_NODE
DOCUMENT_TYPE_NODE
DOCUMENT_FRAGMENT_NODE
NOTATION_NODE
ELEMENT_DECL_NODE
ATT_DEF_NODE
XML_DECL_NODE
ATTLIST_DECL_NODE
)
;
}
sub
UNKNOWN_NODE () { 0 }
sub
ELEMENT_NODE () { 1 }
sub
ATTRIBUTE_NODE () { 2 }
sub
TEXT_NODE () { 3 }
sub
CDATA_SECTION_NODE () { 4 }
sub
ENTITY_REFERENCE_NODE () { 5 }
sub
ENTITY_NODE () { 6 }
sub
PROCESSING_INSTRUCTION_NODE () { 7 }
sub
COMMENT_NODE () { 8 }
sub
DOCUMENT_NODE () { 9 }
sub
DOCUMENT_TYPE_NODE () { 10}
sub
DOCUMENT_FRAGMENT_NODE () { 11}
sub
NOTATION_NODE () { 12}
sub
ELEMENT_DECL_NODE () { 13 }
sub
ATT_DEF_NODE () { 14 }
sub
XML_DECL_NODE () { 15 }
sub
ATTLIST_DECL_NODE () { 16 }
%DefaultEntities
=
(
"quot"
=>
'"'
,
"gt"
=>
">"
,
"lt"
=>
"<"
,
"apos"
=>
"'"
,
"amp"
=>
"&"
);
%DecodeDefaultEntity
=
(
'"'
=> "
"
;",
">"
=>
">"
,
"<"
=>
"<"
,
"'"
=>
"'"
,
"&"
=>
"&"
);
sub
warning
{
warn
@_
;
}
sub
def_fields
{
my
(
$fields
,
$parent
) =
@_
;
my
(
$pkg
) =
caller
;
no
strict
'refs'
;
my
@f
=
split
(/\s+/,
$fields
);
my
$n
= 0;
my
%hfields
;
if
(
defined
$parent
)
{
my
%pf
= %{
"$parent\::HFIELDS"
};
%hfields
=
%pf
;
$n
=
scalar
(
keys
%pf
);
@{
"$pkg\::ISA"
} = (
$parent
);
}
my
$i
=
$n
;
for
(
@f
)
{
eval
"sub $pkg\::_$_ () { $i }"
;
$hfields
{
$_
} =
$i
;
$i
++;
}
%{
"$pkg\::HFIELDS"
} =
%hfields
;
@{
"$pkg\::EXPORT_OK"
} =
map
{
"_$_"
}
@f
;
${
"$pkg\::EXPORT_TAGS"
}{Fields} = [
map
{
"_$_"
}
@f
];
}
sub
encodeCDATA
{
my
(
$str
) =
shift
;
$str
=~ s/]]>/]]
>
;/go;
$str
;
}
sub
encodeProcessingInstruction
{
my
(
$str
) =
shift
;
$str
=~ s/\?>/?
>
;/go;
$str
;
}
sub
encodeComment
{
my
(
$str
) =
shift
;
return
undef
unless
defined
$str
;
$str
=~ s/--/&
$str
;
}
sub
toHex
{
my
$str
=
shift
;
my
$len
=
length
(
$str
);
my
@a
=
unpack
(
"C$len"
,
$str
);
my
$s
=
""
;
for
(
@a
)
{
$s
.=
sprintf
(
"%02x"
,
$_
);
}
$s
;
}
sub
encodeText
{
my
(
$str
,
$default
) =
@_
;
return
undef
unless
defined
$str
;
if
($] >= 5.006) {
$str
=~ s/([
$default
])|(]]>)/
defined
($1) ?
$DecodeDefaultEntity
{$1} :
"]]>"
/egs;
}
else
{
$str
=~ s/([\xC0-\xDF].|[\xE0-\xEF]..|[\xF0-\xFF]...)|([
$default
])|(]]>)/
defined
($1) ? XmlUtf8Decode ($1) :
defined
($2) ?
$DecodeDefaultEntity
{$2} :
"]]>"
/egs;
}
$str
;
}
sub
encodeAttrValue
{
encodeText (
shift
,
'"&<>'
);
}
sub
XmlUtf8Encode
{
my
$n
=
shift
;
if
(
$n
< 0x80)
{
return
chr
(
$n
);
}
elsif
(
$n
< 0x800)
{
return
pack
(
"CC"
, ((
$n
>> 6) | 0xc0), ((
$n
& 0x3f) | 0x80));
}
elsif
(
$n
< 0x10000)
{
return
pack
(
"CCC"
, ((
$n
>> 12) | 0xe0), (((
$n
>> 6) & 0x3f) | 0x80),
((
$n
& 0x3f) | 0x80));
}
elsif
(
$n
< 0x110000)
{
return
pack
(
"CCCC"
, ((
$n
>> 18) | 0xf0), (((
$n
>> 12) & 0x3f) | 0x80),
(((
$n
>> 6) & 0x3f) | 0x80), ((
$n
& 0x3f) | 0x80));
}
croak
"number is too large for Unicode [$n] in &XmlUtf8Encode"
;
}
sub
XmlUtf8Decode
{
my
(
$str
,
$hex
) =
@_
;
my
$len
=
length
(
$str
);
my
$n
;
if
(
$len
== 2)
{
my
@n
=
unpack
"C2"
,
$str
;
$n
= ((
$n
[0] & 0x3f) << 6) + (
$n
[1] & 0x3f);
}
elsif
(
$len
== 3)
{
my
@n
=
unpack
"C3"
,
$str
;
$n
= ((
$n
[0] & 0x1f) << 12) + ((
$n
[1] & 0x3f) << 6) +
(
$n
[2] & 0x3f);
}
elsif
(
$len
== 4)
{
my
@n
=
unpack
"C4"
,
$str
;
$n
= ((
$n
[0] & 0x0f) << 18) + ((
$n
[1] & 0x3f) << 12) +
((
$n
[2] & 0x3f) << 6) + (
$n
[3] & 0x3f);
}
elsif
(
$len
== 1)
{
$n
=
ord
(
$str
);
}
else
{
croak
"bad value [$str] for XmlUtf8Decode"
;
}
$hex
?
sprintf
(
"&#x%x;"
,
$n
) :
"&#$n;"
;
}
$IgnoreReadOnly
= 0;
$SafeMode
= 1;
sub
getIgnoreReadOnly
{
$IgnoreReadOnly
;
}
sub
ignoreReadOnly
{
my
$i
=
$IgnoreReadOnly
;
$IgnoreReadOnly
=
$_
[0];
return
$i
;
}
sub
forgiving_isValidName
{
$_
[0] =~ /^
$XML::RegExp::Name
$/o;
}
sub
picky_isValidName
{
$_
[0] =~ /^
$XML::RegExp::Name
$/o and
$_
[0] !~ /^xml/i;
}
*isValidName
= \
&forgiving_isValidName
;
sub
allowReservedNames
{
*isValidName
= (
$_
[0] ? \
&forgiving_isValidName
: \
&picky_isValidName
);
}
sub
getAllowReservedNames
{
*isValidName
== \
&forgiving_isValidName
;
}
$TagStyle
=
sub
{ 0 };
sub
setTagCompression
{
$TagStyle
=
shift
;
}
sub
new
{
my
(
$class
,
$fn
) =
@_
;
bless
$fn
,
$class
;
}
sub
print
{
my
(
$self
,
$str
) =
@_
;
print
$self
$str
;
}
use
vars
qw{ $Singleton }
;
sub
new
{
my
(
$class
) =
@_
;
my
$str
=
""
;
bless
\
$str
,
$class
;
}
sub
print
{
my
(
$self
,
$str
) =
@_
;
$$self
.=
$str
;
}
sub
toString
{
my
$self
=
shift
;
$$self
;
}
sub
reset
{
${
$_
[0]} =
""
;
}
$Singleton
= new XML::DOM::PrintToString;
$XML::DOM::DOMImplementation::Singleton
=
bless
\
$XML::DOM::DOMImplementation::Singleton
,
'XML::DOM::DOMImplementation'
;
sub
hasFeature
{
my
(
$self
,
$feature
,
$version
) =
@_
;
uc
(
$feature
) eq
'XML'
and (
$version
eq
'1.0'
||
$version
eq
''
);
}
use
vars
qw( @NodeNames @EXPORT @ISA %HFIELDS @EXPORT_OK @EXPORT_TAGS )
;
BEGIN
{
import
Carp;
@ISA
=
qw( Exporter XML::XQL::Node )
;
XML::DOM::def_fields (
"C A Doc Parent ReadOnly UsedIn Hidden SortKey UserData"
);
push
(
@EXPORT
,
qw(
UNKNOWN_NODE
ELEMENT_NODE
ATTRIBUTE_NODE
TEXT_NODE
CDATA_SECTION_NODE
ENTITY_REFERENCE_NODE
ENTITY_NODE
PROCESSING_INSTRUCTION_NODE
COMMENT_NODE
DOCUMENT_NODE
DOCUMENT_TYPE_NODE
DOCUMENT_FRAGMENT_NODE
NOTATION_NODE
ELEMENT_DECL_NODE
ATT_DEF_NODE
XML_DECL_NODE
ATTLIST_DECL_NODE
)
);
}
sub
UNKNOWN_NODE () {0;}
sub
ELEMENT_NODE () {1;}
sub
ATTRIBUTE_NODE () {2;}
sub
TEXT_NODE () {3;}
sub
CDATA_SECTION_NODE () {4;}
sub
ENTITY_REFERENCE_NODE () {5;}
sub
ENTITY_NODE () {6;}
sub
PROCESSING_INSTRUCTION_NODE () {7;}
sub
COMMENT_NODE () {8;}
sub
DOCUMENT_NODE () {9;}
sub
DOCUMENT_TYPE_NODE () {10;}
sub
DOCUMENT_FRAGMENT_NODE () {11;}
sub
NOTATION_NODE () {12;}
sub
ELEMENT_DECL_NODE () {13;}
sub
ATT_DEF_NODE () {14;}
sub
XML_DECL_NODE () {15;}
sub
ATTLIST_DECL_NODE () {16;}
@NodeNames
= (
"UNKNOWN_NODE"
,
"ELEMENT_NODE"
,
"ATTRIBUTE_NODE"
,
"TEXT_NODE"
,
"CDATA_SECTION_NODE"
,
"ENTITY_REFERENCE_NODE"
,
"ENTITY_NODE"
,
"PROCESSING_INSTRUCTION_NODE"
,
"COMMENT_NODE"
,
"DOCUMENT_NODE"
,
"DOCUMENT_TYPE_NODE"
,
"DOCUMENT_FRAGMENT_NODE"
,
"NOTATION_NODE"
,
"ELEMENT_DECL_NODE"
,
"ATT_DEF_NODE"
,
"XML_DECL_NODE"
,
"ATTLIST_DECL_NODE"
);
sub
decoupleUsedIn
{
my
$self
=
shift
;
undef
$self
->[_UsedIn];
}
sub
getParentNode
{
$_
[0]->[_Parent];
}
sub
appendChild
{
my
(
$self
,
$node
) =
@_
;
if
(
$XML::DOM::SafeMode
)
{
croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR,
"node is ReadOnly"
)
if
$self
->isReadOnly;
}
my
$doc
=
$self
->[_Doc];
if
(
$node
->isDocumentFragmentNode)
{
if
(
$XML::DOM::SafeMode
)
{
for
my
$n
(@{
$node
->[_C]})
{
croak new XML::DOM::DOMException (WRONG_DOCUMENT_ERR,
"nodes belong to different documents"
)
if
$doc
!=
$n
->[_Doc];
croak new XML::DOM::DOMException (HIERARCHY_REQUEST_ERR,
"node is ancestor of parent node"
)
if
$n
->isAncestor (
$self
);
croak new XML::DOM::DOMException (HIERARCHY_REQUEST_ERR,
"bad node type"
)
if
$self
->rejectChild (
$n
);
}
}
my
@list
= @{
$node
->[_C]};
for
my
$n
(
@list
)
{
$n
->setParentNode (
$self
);
}
push
@{
$self
->[_C]},
@list
;
}
else
{
if
(
$XML::DOM::SafeMode
)
{
croak new XML::DOM::DOMException (WRONG_DOCUMENT_ERR,
"nodes belong to different documents"
)
if
$doc
!=
$node
->[_Doc];
croak new XML::DOM::DOMException (HIERARCHY_REQUEST_ERR,
"node is ancestor of parent node"
)
if
$node
->isAncestor (
$self
);
croak new XML::DOM::DOMException (HIERARCHY_REQUEST_ERR,
"bad node type"
)
if
$self
->rejectChild (
$node
);
}
$node
->setParentNode (
$self
);
push
@{
$self
->[_C]},
$node
;
}
$node
;
}
sub
getChildNodes
{
my
$kids
=
$_
[0]->[_C];
wantarray
? (
defined
(
$kids
) ? @{
$kids
} : ()) :
(
defined
(
$kids
) ?
$kids
:
$XML::DOM::NodeList::EMPTY
);
}
sub
hasChildNodes
{
my
$kids
=
$_
[0]->[_C];
defined
(
$kids
) &&
@$kids
> 0;
}
sub
getOwnerDocument
{
$_
[0]->[_Doc];
}
sub
getFirstChild
{
my
$kids
=
$_
[0]->[_C];
defined
$kids
?
$kids
->[0] :
undef
;
}
sub
getLastChild
{
my
$kids
=
$_
[0]->[_C];
defined
$kids
?
$kids
->[-1] :
undef
;
}
sub
getPreviousSibling
{
my
$self
=
shift
;
my
$pa
=
$self
->[_Parent];
return
undef
unless
$pa
;
my
$index
=
$pa
->getChildIndex (
$self
);
return
undef
unless
$index
;
$pa
->getChildAtIndex (
$index
- 1);
}
sub
getNextSibling
{
my
$self
=
shift
;
my
$pa
=
$self
->[_Parent];
return
undef
unless
$pa
;
$pa
->getChildAtIndex (
$pa
->getChildIndex (
$self
) + 1);
}
sub
insertBefore
{
my
(
$self
,
$node
,
$refNode
) =
@_
;
return
$self
->appendChild (
$node
)
unless
$refNode
;
croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR,
"node is ReadOnly"
)
if
$self
->isReadOnly;
my
@nodes
= (
$node
);
@nodes
= @{
$node
->[_C]}
if
$node
->getNodeType == DOCUMENT_FRAGMENT_NODE;
my
$doc
=
$self
->[_Doc];
for
my
$n
(
@nodes
)
{
croak new XML::DOM::DOMException (WRONG_DOCUMENT_ERR,
"nodes belong to different documents"
)
if
$doc
!=
$n
->[_Doc];
croak new XML::DOM::DOMException (HIERARCHY_REQUEST_ERR,
"node is ancestor of parent node"
)
if
$n
->isAncestor (
$self
);
croak new XML::DOM::DOMException (HIERARCHY_REQUEST_ERR,
"bad node type"
)
if
$self
->rejectChild (
$n
);
}
my
$index
=
$self
->getChildIndex (
$refNode
);
croak new XML::DOM::DOMException (NOT_FOUND_ERR,
"reference node not found"
)
if
$index
== -1;
for
my
$n
(
@nodes
)
{
$n
->setParentNode (
$self
);
}
splice
(@{
$self
->[_C]},
$index
, 0,
@nodes
);
$node
;
}
sub
replaceChild
{
my
(
$self
,
$node
,
$refNode
) =
@_
;
croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR,
"node is ReadOnly"
)
if
$self
->isReadOnly;
my
@nodes
= (
$node
);
@nodes
= @{
$node
->[_C]}
if
$node
->getNodeType == DOCUMENT_FRAGMENT_NODE;
for
my
$n
(
@nodes
)
{
croak new XML::DOM::DOMException (WRONG_DOCUMENT_ERR,
"nodes belong to different documents"
)
if
$self
->[_Doc] !=
$n
->[_Doc];
croak new XML::DOM::DOMException (HIERARCHY_REQUEST_ERR,
"node is ancestor of parent node"
)
if
$n
->isAncestor (
$self
);
croak new XML::DOM::DOMException (HIERARCHY_REQUEST_ERR,
"bad node type"
)
if
$self
->rejectChild (
$n
);
}
my
$index
=
$self
->getChildIndex (
$refNode
);
croak new XML::DOM::DOMException (NOT_FOUND_ERR,
"reference node not found"
)
if
$index
== -1;
for
my
$n
(
@nodes
)
{
$n
->setParentNode (
$self
);
}
splice
(@{
$self
->[_C]},
$index
, 1,
@nodes
);
$refNode
->removeChildHoodMemories;
$refNode
;
}
sub
removeChild
{
my
(
$self
,
$node
) =
@_
;
croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR,
"node is ReadOnly"
)
if
$self
->isReadOnly;
my
$index
=
$self
->getChildIndex (
$node
);
croak new XML::DOM::DOMException (NOT_FOUND_ERR,
"reference node not found"
)
if
$index
== -1;
splice
(@{
$self
->[_C]},
$index
, 1, ());
$node
->removeChildHoodMemories;
$node
;
}
sub
normalize
{
my
(
$self
) =
shift
;
my
$prev
=
undef
;
return
unless
defined
$self
->[_C];
my
@nodes
= @{
$self
->[_C]};
my
$i
= 0;
my
$n
=
@nodes
;
while
(
$i
<
$n
)
{
my
$node
=
$self
->getChildAtIndex(
$i
);
my
$type
=
$node
->getNodeType;
if
(
defined
$prev
)
{
if
(
$type
== TEXT_NODE)
{
$prev
->appendData (
$node
->getData);
$self
->removeChild (
$node
);
$i
--;
$n
--;
}
else
{
$prev
=
undef
;
if
(
$type
== ELEMENT_NODE)
{
$node
->normalize;
if
(
defined
$node
->[_A])
{
for
my
$attr
(@{
$node
->[_A]->getValues})
{
$attr
->normalize;
}
}
}
}
}
else
{
if
(
$type
== TEXT_NODE)
{
$prev
=
$node
;
}
elsif
(
$type
== ELEMENT_NODE)
{
$node
->normalize;
if
(
defined
$node
->[_A])
{
for
my
$attr
(@{
$node
->[_A]->getValues})
{
$attr
->normalize;
}
}
}
}
$i
++;
}
}
sub
getElementsByTagName
{
my
(
$self
,
$tagName
,
$recurse
,
$list
) =
@_
;
$recurse
= 1
unless
defined
$recurse
;
$list
= (
wantarray
? [] : new XML::DOM::NodeList)
unless
defined
$list
;
return
unless
defined
$self
->[_C];
for
my
$kid
(@{
$self
->[_C]})
{
if
(
$kid
->isElementNode)
{
if
(
$tagName
eq
"*"
||
$tagName
eq
$kid
->getTagName)
{
push
@{
$list
},
$kid
;
}
$kid
->getElementsByTagName (
$tagName
,
$recurse
,
$list
)
if
$recurse
;
}
}
wantarray
? @{
$list
} :
$list
;
}
sub
getNodeValue
{
undef
;
}
sub
setNodeValue
{
}
sub
getAttributes
{
undef
;
}
sub
setOwnerDocument
{
my
(
$self
,
$doc
) =
@_
;
$self
->[_Doc] =
$doc
;
return
unless
defined
$self
->[_C];
for
my
$kid
(@{
$self
->[_C]})
{
$kid
->setOwnerDocument (
$doc
);
}
}
sub
cloneChildren
{
my
(
$self
,
$node
,
$deep
) =
@_
;
return
unless
$deep
;
return
unless
defined
$self
->[_C];
local
$XML::DOM::IgnoreReadOnly
= 1;
for
my
$kid
(@{
$node
->[_C]})
{
my
$newNode
=
$kid
->cloneNode (
$deep
);
push
@{
$self
->[_C]},
$newNode
;
$newNode
->setParentNode (
$self
);
}
}
sub
removeChildHoodMemories
{
my
(
$self
) =
@_
;
undef
$self
->[_Parent];
}
sub
dispose
{
my
$self
=
shift
;
$self
->removeChildHoodMemories;
if
(
defined
$self
->[_C])
{
$self
->[_C]->dispose;
undef
$self
->[_C];
}
undef
$self
->[_Doc];
}
sub
setParentNode
{
my
(
$self
,
$parent
) =
@_
;
my
$oldParent
=
$self
->[_Parent];
if
(
defined
$oldParent
)
{
my
$index
=
$oldParent
->getChildIndex (
$self
);
splice
(@{
$oldParent
->[_C]},
$index
, 1, ());
$self
->removeChildHoodMemories;
}
$self
->[_Parent] =
$parent
;
}
sub
isReadOnly
{
!
$XML::DOM::IgnoreReadOnly
;
}
sub
rejectChild
{
1;
}
sub
getNodeTypeName
{
$NodeNames
[
$_
[0]->getNodeType];
}
sub
getChildIndex
{
my
(
$self
,
$node
) =
@_
;
my
$i
= 0;
return
-1
unless
defined
$self
->[_C];
for
my
$kid
(@{
$self
->[_C]})
{
return
$i
if
$kid
==
$node
;
$i
++;
}
-1;
}
sub
getChildAtIndex
{
my
$kids
=
$_
[0]->[_C];
defined
(
$kids
) ?
$kids
->[
$_
[1]] :
undef
;
}
sub
isAncestor
{
my
(
$self
,
$node
) =
@_
;
do
{
return
1
if
$self
==
$node
;
$node
=
$node
->[_Parent];
}
while
(
defined
$node
);
0;
}
sub
isTextNode
{
0;
}
sub
isDocumentFragmentNode
{
0;
}
sub
isElementNode
{
0;
}
sub
addText
{
my
(
$self
,
$str
) =
@_
;
my
$node
= ${
$self
->[_C]}[-1];
if
(
defined
(
$node
) &&
$node
->isTextNode)
{
$node
->appendData (
$str
);
}
else
{
$node
=
$self
->[_Doc]->createTextNode (
$str
);
$self
->appendChild (
$node
);
}
$node
;
}
sub
addCDATA
{
my
(
$self
,
$str
) =
@_
;
my
$node
= ${
$self
->[_C]}[-1];
if
(
defined
(
$node
) &&
$node
->getNodeType == CDATA_SECTION_NODE)
{
$node
->appendData (
$str
);
}
else
{
$node
=
$self
->[_Doc]->createCDATASection (
$str
);
$self
->appendChild (
$node
);
}
}
sub
removeChildNodes
{
my
$self
=
shift
;
my
$cref
=
$self
->[_C];
return
unless
defined
$cref
;
my
$kid
;
while
(
$kid
=
pop
@{
$cref
})
{
undef
$kid
->[_Parent];
}
}
sub
toString
{
my
$self
=
shift
;
my
$pr
=
$XML::DOM::PrintToString::Singleton
;
$pr
->
reset
;
$self
->
print
(
$pr
);
$pr
->toString;
}
sub
to_sax
{
my
$self
=
shift
;
unshift
@_
,
'Handler'
if
(
@_
== 1);
my
%h
=
@_
;
my
$doch
=
exists
(
$h
{DocumentHandler}) ?
$h
{DocumentHandler}
:
$h
{Handler};
my
$dtdh
=
exists
(
$h
{DTDHandler}) ?
$h
{DTDHandler}
:
$h
{Handler};
my
$enth
=
exists
(
$h
{EntityResolver}) ?
$h
{EntityResolver}
:
$h
{Handler};
$self
->_to_sax (
$doch
,
$dtdh
,
$enth
);
}
sub
printToFile
{
my
(
$self
,
$fileName
) =
@_
;
my
$encoding
=
$self
->getXMLDecl()->getEncoding();
my
$fh
= new FileHandle (
$fileName
,
">:encoding($encoding)"
) ||
croak
"printToFile - can't open output file $fileName"
;
$self
->
print
(
$fh
);
$fh
->
close
;
}
sub
printToFileHandle
{
my
(
$self
,
$FH
) =
@_
;
my
$pr
= new XML::DOM::PrintToFileHandle (
$FH
);
$self
->
print
(
$pr
);
}
sub
expandEntityRefs
{
my
(
$self
,
$str
) =
@_
;
my
$doctype
=
$self
->[_Doc]->getDoctype;
$str
=~ s/&(
$XML::RegExp::Name
|(
defined
($2) ? XML::DOM::XmlUtf8Encode ($3 ||
hex
($4))
: expandEntityRef ($1,
$doctype
)/ego;
$str
;
}
sub
expandEntityRef
{
my
(
$entity
,
$doctype
) =
@_
;
my
$expanded
=
$XML::DOM::DefaultEntities
{
$entity
};
return
$expanded
if
defined
$expanded
;
$expanded
=
$doctype
->getEntity (
$entity
);
return
$expanded
->getValue
if
(
defined
$expanded
);
croak
"Could not expand entity reference of [$entity]\n"
;
}
sub
isHidden
{
$_
[0]->[_Hidden];
}
use
vars
qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS }
;
BEGIN
{
import
XML::DOM::Node
qw( :DEFAULT :Fields )
;
XML::DOM::def_fields (
"Name Specified"
,
"XML::DOM::Node"
);
}
sub
new
{
my
(
$class
,
$doc
,
$name
,
$value
,
$specified
) =
@_
;
if
(
$XML::DOM::SafeMode
)
{
croak new XML::DOM::DOMException (INVALID_CHARACTER_ERR,
"bad Attr name [$name]"
)
unless
XML::DOM::isValidName (
$name
);
}
my
$self
=
bless
[],
$class
;
$self
->[_Doc] =
$doc
;
$self
->[_C] = new XML::DOM::NodeList;
$self
->[_Name] =
$name
;
if
(
defined
$value
)
{
$self
->setValue (
$value
);
$self
->[_Specified] = (
defined
$specified
) ?
$specified
: 1;
}
else
{
$self
->[_Specified] = 0;
}
$self
;
}
sub
getNodeType
{
ATTRIBUTE_NODE;
}
sub
isSpecified
{
$_
[0]->[_Specified];
}
sub
getName
{
$_
[0]->[_Name];
}
sub
getValue
{
my
$self
=
shift
;
my
$value
=
""
;
for
my
$kid
(@{
$self
->[_C]})
{
$value
.=
$kid
->getData
if
defined
$kid
->getData;
}
$value
;
}
sub
setValue
{
my
(
$self
,
$value
) =
@_
;
$self
->removeChildNodes;
$self
->appendChild (
$self
->[_Doc]->createTextNode (
$value
));
$self
->[_Specified] = 1;
}
sub
getNodeName
{
$_
[0]->getName;
}
sub
getNodeValue
{
$_
[0]->getValue;
}
sub
setNodeValue
{
$_
[0]->setValue (
$_
[1]);
}
sub
cloneNode
{
my
(
$self
) =
@_
;
my
$node
=
$self
->[_Doc]->createAttribute (
$self
->getName);
$node
->[_Specified] =
$self
->[_Specified];
$node
->[_ReadOnly] = 1
if
$self
->[_ReadOnly];
$node
->cloneChildren (
$self
, 1);
$node
;
}
sub
isReadOnly
{
!
$XML::DOM::IgnoreReadOnly
&&
defined
(
$_
[0]->[_ReadOnly]);
}
sub
print
{
my
(
$self
,
$FILE
) =
@_
;
my
$name
=
$self
->[_Name];
$FILE
->
print
(
"$name=\""
);
for
my
$kid
(@{
$self
->[_C]})
{
if
(
$kid
->getNodeType == TEXT_NODE)
{
$FILE
->
print
(XML::DOM::encodeAttrValue (
$kid
->getData));
}
else
{
$kid
->
print
(
$FILE
);
}
}
$FILE
->
print
(
"\""
);
}
sub
rejectChild
{
my
$t
=
$_
[1]->getNodeType;
$t
!= TEXT_NODE
&&
$t
!= ENTITY_REFERENCE_NODE;
}
use
vars
qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS }
;
BEGIN
{
import
XML::DOM::Node
qw( :DEFAULT :Fields )
;
XML::DOM::def_fields (
"Target Data"
,
"XML::DOM::Node"
);
}
sub
new
{
my
(
$class
,
$doc
,
$target
,
$data
,
$hidden
) =
@_
;
croak new XML::DOM::DOMException (INVALID_CHARACTER_ERR,
"bad ProcessingInstruction Target [$target]"
)
unless
(XML::DOM::isValidName (
$target
) &&
$target
!~ /^xml$/io);
my
$self
=
bless
[],
$class
;
$self
->[_Doc] =
$doc
;
$self
->[_Target] =
$target
;
$self
->[_Data] =
$data
;
$self
->[_Hidden] =
$hidden
;
$self
;
}
sub
getNodeType
{
PROCESSING_INSTRUCTION_NODE;
}
sub
getTarget
{
$_
[0]->[_Target];
}
sub
getData
{
$_
[0]->[_Data];
}
sub
setData
{
my
(
$self
,
$data
) =
@_
;
croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR,
"node is ReadOnly"
)
if
$self
->isReadOnly;
$self
->[_Data] =
$data
;
}
sub
getNodeName
{
$_
[0]->[_Target];
}
sub
getNodeValue
{
$_
[0]->[_Data];
}
sub
setNodeValue
{
$_
[0]->setData (
$_
[1]);
}
sub
cloneNode
{
my
$self
=
shift
;
$self
->[_Doc]->createProcessingInstruction (
$self
->getTarget,
$self
->getData,
$self
->isHidden);
}
sub
isReadOnly
{
return
0
if
$XML::DOM::IgnoreReadOnly
;
my
$pa
=
$_
[0]->[_Parent];
defined
(
$pa
) ?
$pa
->isReadOnly : 0;
}
sub
print
{
my
(
$self
,
$FILE
) =
@_
;
$FILE
->
print
(
"<?"
);
$FILE
->
print
(
$self
->[_Target]);
$FILE
->
print
(
" "
);
$FILE
->
print
(XML::DOM::encodeProcessingInstruction (
$self
->[_Data]));
$FILE
->
print
(
"?>"
);
}
sub
_to_sax {
my
(
$self
,
$doch
) =
@_
;
$doch
->processing_instruction({
Target
=>
$self
->getTarget,
Data
=>
$self
->getData});
}
use
vars
qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS }
;
BEGIN
{
import
XML::DOM::Node
qw( :DEFAULT :Fields )
;
XML::DOM::def_fields (
"Name Base SysId PubId"
,
"XML::DOM::Node"
);
}
sub
new
{
my
(
$class
,
$doc
,
$name
,
$base
,
$sysId
,
$pubId
,
$hidden
) =
@_
;
croak new XML::DOM::DOMException (INVALID_CHARACTER_ERR,
"bad Notation Name [$name]"
)
unless
XML::DOM::isValidName (
$name
);
my
$self
=
bless
[],
$class
;
$self
->[_Doc] =
$doc
;
$self
->[_Name] =
$name
;
$self
->[_Base] =
$base
;
$self
->[_SysId] =
$sysId
;
$self
->[_PubId] =
$pubId
;
$self
->[_Hidden] =
$hidden
;
$self
;
}
sub
getNodeType
{
NOTATION_NODE;
}
sub
getPubId
{
$_
[0]->[_PubId];
}
sub
setPubId
{
$_
[0]->[_PubId] =
$_
[1];
}
sub
getSysId
{
$_
[0]->[_SysId];
}
sub
setSysId
{
$_
[0]->[_SysId] =
$_
[1];
}
sub
getName
{
$_
[0]->[_Name];
}
sub
setName
{
$_
[0]->[_Name] =
$_
[1];
}
sub
getBase
{
$_
[0]->[_Base];
}
sub
getNodeName
{
$_
[0]->[_Name];
}
sub
print
{
my
(
$self
,
$FILE
) =
@_
;
my
$name
=
$self
->[_Name];
my
$sysId
=
$self
->[_SysId];
my
$pubId
=
$self
->[_PubId];
$FILE
->
print
(
"<!NOTATION $name "
);
if
(
defined
$pubId
)
{
$FILE
->
print
(
" PUBLIC \"$pubId\""
);
}
if
(
defined
$sysId
)
{
$FILE
->
print
(
" SYSTEM \"$sysId\""
);
}
$FILE
->
print
(
">"
);
}
sub
cloneNode
{
my
(
$self
) =
@_
;
$self
->[_Doc]->createNotation (
$self
->[_Name],
$self
->[_Base],
$self
->[_SysId],
$self
->[_PubId],
$self
->[_Hidden]);
}
sub
to_expat
{
my
(
$self
,
$iter
) =
@_
;
$iter
->Notation (
$self
->getName,
$self
->getBase,
$self
->getSysId,
$self
->getPubId);
}
sub
_to_sax
{
my
(
$self
,
$doch
,
$dtdh
,
$enth
) =
@_
;
$dtdh
->notation_decl ( {
Name
=>
$self
->getName,
Base
=>
$self
->getBase,
SystemId
=>
$self
->getSysId,
PublicId
=>
$self
->getPubId });
}
use
vars
qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS }
;
BEGIN
{
import
XML::DOM::Node
qw( :DEFAULT :Fields )
;
XML::DOM::def_fields (
"NotationName Parameter Value Ndata SysId PubId"
,
"XML::DOM::Node"
);
}
sub
new
{
my
(
$class
,
$doc
,
$notationName
,
$value
,
$sysId
,
$pubId
,
$ndata
,
$isParam
,
$hidden
) =
@_
;
croak new XML::DOM::DOMException (INVALID_CHARACTER_ERR,
"bad Entity Name [$notationName]"
)
unless
XML::DOM::isValidName (
$notationName
);
my
$self
=
bless
[],
$class
;
$self
->[_Doc] =
$doc
;
$self
->[_NotationName] =
$notationName
;
$self
->[_Parameter] =
$isParam
;
$self
->[_Value] =
$value
;
$self
->[_Ndata] =
$ndata
;
$self
->[_SysId] =
$sysId
;
$self
->[_PubId] =
$pubId
;
$self
->[_Hidden] =
$hidden
;
$self
;
}
sub
getNodeType
{
ENTITY_NODE;
}
sub
getPubId
{
$_
[0]->[_PubId];
}
sub
getSysId
{
$_
[0]->[_SysId];
}
sub
getNotationName
{
$_
[0]->[_NotationName];
}
sub
getNodeName
{
$_
[0]->[_NotationName];
}
sub
cloneNode
{
my
$self
=
shift
;
$self
->[_Doc]->createEntity (
$self
->[_NotationName],
$self
->[_Value],
$self
->[_SysId],
$self
->[_PubId],
$self
->[_Ndata],
$self
->[_Parameter],
$self
->[_Hidden]);
}
sub
rejectChild
{
return
1;
my
$t
=
$_
[1];
return
$t
== TEXT_NODE
||
$t
== ENTITY_REFERENCE_NODE
||
$t
== PROCESSING_INSTRUCTION_NODE
||
$t
== COMMENT_NODE
||
$t
== CDATA_SECTION_NODE
||
$t
== ELEMENT_NODE;
}
sub
getValue
{
$_
[0]->[_Value];
}
sub
isParameterEntity
{
$_
[0]->[_Parameter];
}
sub
getNdata
{
$_
[0]->[_Ndata];
}
sub
print
{
my
(
$self
,
$FILE
) =
@_
;
my
$name
=
$self
->[_NotationName];
my
$par
=
$self
->isParameterEntity ?
"% "
:
""
;
$FILE
->
print
(
"<!ENTITY $par$name"
);
my
$value
=
$self
->[_Value];
my
$sysId
=
$self
->[_SysId];
my
$pubId
=
$self
->[_PubId];
my
$ndata
=
$self
->[_Ndata];
if
(
defined
$value
)
{
$value
= (
$value
=~ /\
"/) ? "
'$value'
" : "
\
"$value\""
;
$FILE
->
print
(
" $value"
);
}
if
(
defined
$pubId
)
{
$FILE
->
print
(
" PUBLIC \"$pubId\""
);
}
elsif
(
defined
$sysId
)
{
$FILE
->
print
(
" SYSTEM"
);
}
if
(
defined
$sysId
)
{
$FILE
->
print
(
" \"$sysId\""
);
}
$FILE
->
print
(
" NDATA $ndata"
)
if
defined
$ndata
;
$FILE
->
print
(
">"
);
}
sub
to_expat
{
my
(
$self
,
$iter
) =
@_
;
my
$name
= (
$self
->isParameterEntity ?
'%'
:
""
) .
$self
->getNotationName;
$iter
->Entity (
$name
,
$self
->getValue,
$self
->getSysId,
$self
->getPubId,
$self
->getNdata);
}
sub
_to_sax
{
my
(
$self
,
$doch
,
$dtdh
,
$enth
) =
@_
;
my
$name
= (
$self
->isParameterEntity ?
'%'
:
""
) .
$self
->getNotationName;
$dtdh
->entity_decl ( {
Name
=>
$name
,
Value
=>
$self
->getValue,
SystemId
=>
$self
->getSysId,
PublicId
=>
$self
->getPubId,
Notation
=>
$self
->getNdata } );
}
use
vars
qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS }
;
BEGIN
{
import
XML::DOM::Node
qw( :DEFAULT :Fields )
;
XML::DOM::def_fields (
"EntityName Parameter NoExpand"
,
"XML::DOM::Node"
);
}
sub
new
{
my
(
$class
,
$doc
,
$name
,
$parameter
,
$noExpand
) =
@_
;
croak new XML::DOM::DOMException (INVALID_CHARACTER_ERR,
"bad Entity Name [$name] in EntityReference"
)
unless
XML::DOM::isValidName (
$name
);
my
$self
=
bless
[],
$class
;
$self
->[_Doc] =
$doc
;
$self
->[_EntityName] =
$name
;
$self
->[_Parameter] = (
$parameter
|| 0);
$self
->[_NoExpand] = (
$noExpand
|| 0);
$self
;
}
sub
getNodeType
{
ENTITY_REFERENCE_NODE;
}
sub
getNodeName
{
$_
[0]->[_EntityName];
}
sub
getEntityName
{
$_
[0]->[_EntityName];
}
sub
isParameterEntity
{
$_
[0]->[_Parameter];
}
sub
getData
{
my
$self
=
shift
;
my
$name
=
$self
->[_EntityName];
my
$parameter
=
$self
->[_Parameter];
my
$data
;
if
(
$self
->[_NoExpand]) {
$data
=
"&$name;"
if
$name
;
}
else
{
$data
=
$self
->[_Doc]->expandEntity (
$name
,
$parameter
);
}
unless
(
defined
$data
)
{
my
$pc
=
$parameter
?
"%"
:
"&"
;
$data
=
"$pc$name;"
;
}
$data
;
}
sub
print
{
my
(
$self
,
$FILE
) =
@_
;
my
$name
=
$self
->[_EntityName];
my
$pc
=
$self
->[_Parameter] ?
"%"
:
"&"
;
$FILE
->
print
(
"$pc$name;"
);
}
sub
getChildNodes
{
my
$self
=
shift
;
my
$entity
=
$self
->[_Doc]->getEntity (
$self
->[_EntityName]);
defined
(
$entity
) ?
$entity
->getChildNodes : new XML::DOM::NodeList;
}
sub
cloneNode
{
my
$self
=
shift
;
$self
->[_Doc]->createEntityReference (
$self
->[_EntityName],
$self
->[_Parameter],
$self
->[_NoExpand],
);
}
sub
to_expat
{
my
(
$self
,
$iter
) =
@_
;
$iter
->EntityRef (
$self
->getEntityName,
$self
->isParameterEntity);
}
sub
_to_sax
{
my
(
$self
,
$doch
,
$dtdh
,
$enth
) =
@_
;
my
@par
=
$self
->isParameterEntity ? (
Parameter
=> 1) : ();
$doch
->entity_reference ( {
Name
=>
$self
->getEntityName,
@par
} );
}
use
vars
qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS }
;
BEGIN
{
import
XML::DOM::Node
qw( :DEFAULT :Fields )
;
XML::DOM::def_fields (
"Name Type Fixed Default Required Implied Quote"
,
"XML::DOM::Node"
);
}
sub
new
{
my
(
$class
,
$doc
,
$name
,
$attrType
,
$default
,
$fixed
,
$hidden
) =
@_
;
croak new XML::DOM::DOMException (INVALID_CHARACTER_ERR,
"bad Attr name in AttDef [$name]"
)
unless
XML::DOM::isValidName (
$name
);
my
$self
=
bless
[],
$class
;
$self
->[_Doc] =
$doc
;
$self
->[_Name] =
$name
;
$self
->[_Type] =
$attrType
;
if
(
defined
$default
)
{
if
(
$default
eq
"#REQUIRED"
)
{
$self
->[_Required] = 1;
}
elsif
(
$default
eq
"#IMPLIED"
)
{
$self
->[_Implied] = 1;
}
else
{
$default
=~ s!^(["'])!!;
$self
->[_Quote] = $1;
$default
=~ s!(["'])$!!;
$self
->[_Default] =
$self
->setDefault (
$default
);
}
}
$self
->[_Fixed] =
$fixed
if
defined
$fixed
;
$self
->[_Hidden] =
$hidden
if
defined
$hidden
;
$self
;
}
sub
getNodeType
{
ATT_DEF_NODE;
}
sub
getName
{
$_
[0]->[_Name];
}
sub
getNodeName
{
$_
[0]->[_Name];
}
sub
getType
{
$_
[0]->[_Type];
}
sub
setType
{
$_
[0]->[_Type] =
$_
[1];
}
sub
getDefault
{
$_
[0]->[_Default];
}
sub
setDefault
{
my
(
$self
,
$value
) =
@_
;
my
$attr
=
$self
->[_Doc]->createAttribute (
$self
->[_Name],
undef
, 0);
$attr
->[_ReadOnly] = 1;
$value
=
$self
->expandEntityRefs (
$value
);
$attr
->addText (
$value
);
$attr
;
}
sub
isFixed
{
$_
[0]->[_Fixed] || 0;
}
sub
isRequired
{
$_
[0]->[_Required] || 0;
}
sub
isImplied
{
$_
[0]->[_Implied] || 0;
}
sub
print
{
my
(
$self
,
$FILE
) =
@_
;
my
$name
=
$self
->[_Name];
my
$type
=
$self
->[_Type];
my
$fixed
=
$self
->[_Fixed];
my
$default
=
$self
->[_Default];
$FILE
->
print
(
$name
);
$FILE
->
print
(
" $type"
);
$FILE
->
print
(
" #FIXED"
)
if
defined
$fixed
;
if
(
$self
->[_Required])
{
$FILE
->
print
(
" #REQUIRED"
);
}
elsif
(
$self
->[_Implied])
{
$FILE
->
print
(
" #IMPLIED"
);
}
elsif
(
defined
(
$default
))
{
my
$quote
=
$self
->[_Quote];
$FILE
->
print
(
" $quote"
);
for
my
$kid
(@{
$default
->[_C]})
{
$kid
->
print
(
$FILE
);
}
$FILE
->
print
(
$quote
);
}
}
sub
getDefaultString
{
my
$self
=
shift
;
my
$default
;
if
(
$self
->[_Required])
{
return
"#REQUIRED"
;
}
elsif
(
$self
->[_Implied])
{
return
"#IMPLIED"
;
}
elsif
(
defined
(
$default
=
$self
->[_Default]))
{
my
$quote
=
$self
->[_Quote];
$default
=
$default
->toString;
return
"$quote$default$quote"
;
}
undef
;
}
sub
cloneNode
{
my
$self
=
shift
;
my
$node
= new XML::DOM::AttDef (
$self
->[_Doc],
$self
->[_Name],
$self
->[_Type],
undef
,
$self
->[_Fixed]);
$node
->[_Required] = 1
if
$self
->[_Required];
$node
->[_Implied] = 1
if
$self
->[_Implied];
$node
->[_Fixed] =
$self
->[_Fixed]
if
defined
$self
->[_Fixed];
$node
->[_Hidden] =
$self
->[_Hidden]
if
defined
$self
->[_Hidden];
if
(
defined
$self
->[_Default])
{
$node
->[_Default] =
$self
->[_Default]->cloneNode(1);
}
$node
->[_Quote] =
$self
->[_Quote];
$node
;
}
sub
setOwnerDocument
{
my
(
$self
,
$doc
) =
@_
;
$self
->SUPER::setOwnerDocument (
$doc
);
if
(
defined
$self
->[_Default])
{
$self
->[_Default]->setOwnerDocument (
$doc
);
}
}
use
vars
qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS }
;
BEGIN
{
import
XML::DOM::Node
qw( :DEFAULT :Fields )
;
import
XML::DOM::AttDef
qw{ :Fields }
;
XML::DOM::def_fields (
"ElementName"
,
"XML::DOM::Node"
);
}
sub
new
{
my
(
$class
,
$doc
,
$name
) =
@_
;
croak new XML::DOM::DOMException (INVALID_CHARACTER_ERR,
"bad Element TagName [$name] in AttlistDecl"
)
unless
XML::DOM::isValidName (
$name
);
my
$self
=
bless
[],
$class
;
$self
->[_Doc] =
$doc
;
$self
->[_C] = new XML::DOM::NodeList;
$self
->[_ReadOnly] = 1;
$self
->[_ElementName] =
$name
;
$self
->[_A] = new XML::DOM::NamedNodeMap (
Doc
=>
$doc
,
ReadOnly
=> 1,
Parent
=>
$self
);
$self
;
}
sub
getNodeType
{
ATTLIST_DECL_NODE;
}
sub
getName
{
$_
[0]->[_ElementName];
}
sub
getNodeName
{
$_
[0]->[_ElementName];
}
sub
getAttDef
{
my
(
$self
,
$attrName
) =
@_
;
$self
->[_A]->getNamedItem (
$attrName
);
}
sub
addAttDef
{
my
(
$self
,
$attrName
,
$type
,
$default
,
$fixed
,
$hidden
) =
@_
;
my
$node
=
$self
->getAttDef (
$attrName
);
if
(
defined
$node
)
{
my
$elemName
=
$self
->getName;
XML::DOM::warning (
"multiple definitions of attribute $attrName for element $elemName, only first one is recognized"
);
}
else
{
$node
= new XML::DOM::AttDef (
$self
->[_Doc],
$attrName
,
$type
,
$default
,
$fixed
,
$hidden
);
$self
->[_A]->setNamedItem (
$node
);
}
$node
;
}
sub
getDefaultAttrValue
{
my
(
$self
,
$attr
) =
@_
;
my
$attrNode
=
$self
->getAttDef (
$attr
);
(
defined
$attrNode
) ?
$attrNode
->getDefault :
undef
;
}
sub
cloneNode
{
my
(
$self
,
$deep
) =
@_
;
my
$node
=
$self
->[_Doc]->createAttlistDecl (
$self
->[_ElementName]);
$node
->[_A] =
$self
->[_A]->cloneNode (
$deep
);
$node
;
}
sub
setOwnerDocument
{
my
(
$self
,
$doc
) =
@_
;
$self
->SUPER::setOwnerDocument (
$doc
);
$self
->[_A]->setOwnerDocument (
$doc
);
}
sub
print
{
my
(
$self
,
$FILE
) =
@_
;
my
$name
=
$self
->getName;
my
@attlist
= @{
$self
->[_A]->getValues};
my
$hidden
= 1;
for
my
$att
(
@attlist
)
{
unless
(
$att
->[_Hidden])
{
$hidden
= 0;
last
;
}
}
unless
(
$hidden
)
{
$FILE
->
print
(
"<!ATTLIST $name"
);
if
(
@attlist
== 1)
{
$FILE
->
print
(
" "
);
$attlist
[0]->
print
(
$FILE
);
}
else
{
for
my
$attr
(
@attlist
)
{
next
if
$attr
->[_Hidden];
$FILE
->
print
(
"\x0A "
);
$attr
->
print
(
$FILE
);
}
}
$FILE
->
print
(
">"
);
}
}
sub
to_expat
{
my
(
$self
,
$iter
) =
@_
;
my
$tag
=
$self
->getName;
for
my
$a
(
$self
->[_A]->getValues)
{
my
$default
=
$a
->isImplied ?
'#IMPLIED'
:
(
$a
->isRequired ?
'#REQUIRED'
:
(
$a
->[_Quote] .
$a
->getDefault->getValue .
$a
->[_Quote]));
$iter
->Attlist (
$tag
,
$a
->getName,
$a
->getType,
$default
,
$a
->isFixed);
}
}
sub
_to_sax
{
my
(
$self
,
$doch
,
$dtdh
,
$enth
) =
@_
;
my
$tag
=
$self
->getName;
for
my
$a
(
$self
->[_A]->getValues)
{
my
$default
=
$a
->isImplied ?
'#IMPLIED'
:
(
$a
->isRequired ?
'#REQUIRED'
:
(
$a
->[_Quote] .
$a
->getDefault->getValue .
$a
->[_Quote]));
$dtdh
->attlist_decl ({
ElementName
=>
$tag
,
AttributeName
=>
$a
->getName,
Type
=>
$a
->[_Type],
Default
=>
$default
,
Fixed
=>
$a
->isFixed });
}
}
use
vars
qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS }
;
BEGIN
{
import
XML::DOM::Node
qw( :DEFAULT :Fields )
;
XML::DOM::def_fields (
"Name Model"
,
"XML::DOM::Node"
);
}
sub
new
{
my
(
$class
,
$doc
,
$name
,
$model
,
$hidden
) =
@_
;
croak new XML::DOM::DOMException (INVALID_CHARACTER_ERR,
"bad Element TagName [$name] in ElementDecl"
)
unless
XML::DOM::isValidName (
$name
);
my
$self
=
bless
[],
$class
;
$self
->[_Doc] =
$doc
;
$self
->[_Name] =
$name
;
$self
->[_ReadOnly] = 1;
$self
->[_Model] =
$model
;
$self
->[_Hidden] =
$hidden
;
$self
;
}
sub
getNodeType
{
ELEMENT_DECL_NODE;
}
sub
getName
{
$_
[0]->[_Name];
}
sub
getNodeName
{
$_
[0]->[_Name];
}
sub
getModel
{
$_
[0]->[_Model];
}
sub
setModel
{
my
(
$self
,
$model
) =
@_
;
$self
->[_Model] =
$model
;
}
sub
print
{
my
(
$self
,
$FILE
) =
@_
;
my
$name
=
$self
->[_Name];
my
$model
=
$self
->[_Model];
$FILE
->
print
(
"<!ELEMENT $name $model>"
)
unless
$self
->[_Hidden];
}
sub
cloneNode
{
my
$self
=
shift
;
$self
->[_Doc]->createElementDecl (
$self
->[_Name],
$self
->[_Model],
$self
->[_Hidden]);
}
sub
to_expat
{
my
(
$self
,
$iter
) =
@_
;
$iter
->Element (
$self
->getName,
$self
->getModel);
}
sub
_to_sax
{
my
(
$self
,
$doch
,
$dtdh
,
$enth
) =
@_
;
$dtdh
->element_decl ( {
Name
=>
$self
->getName,
Model
=>
$self
->getModel } );
}
use
vars
qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS }
;
BEGIN
{
import
XML::DOM::Node
qw( :DEFAULT :Fields )
;
XML::DOM::def_fields (
"TagName"
,
"XML::DOM::Node"
);
}
sub
new
{
my
(
$class
,
$doc
,
$tagName
) =
@_
;
if
(
$XML::DOM::SafeMode
)
{
croak new XML::DOM::DOMException (INVALID_CHARACTER_ERR,
"bad Element TagName [$tagName]"
)
unless
XML::DOM::isValidName (
$tagName
);
}
my
$self
=
bless
[],
$class
;
$self
->[_Doc] =
$doc
;
$self
->[_C] = new XML::DOM::NodeList;
$self
->[_TagName] =
$tagName
;
$self
;
}
sub
getNodeType
{
ELEMENT_NODE;
}
sub
getTagName
{
$_
[0]->[_TagName];
}
sub
getNodeName
{
$_
[0]->[_TagName];
}
sub
getAttributeNode
{
my
(
$self
,
$name
) =
@_
;
return
undef
unless
defined
$self
->[_A];
$self
->getAttributes->{
$name
};
}
sub
getAttribute
{
my
(
$self
,
$name
) =
@_
;
my
$attr
=
$self
->getAttributeNode (
$name
);
(
defined
$attr
) ?
$attr
->getValue :
""
;
}
sub
setAttribute
{
my
(
$self
,
$name
,
$val
) =
@_
;
croak new XML::DOM::DOMException (INVALID_CHARACTER_ERR,
"bad Attr Name [$name]"
)
unless
XML::DOM::isValidName (
$name
);
croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR,
"node is ReadOnly"
)
if
$self
->isReadOnly;
my
$node
=
$self
->getAttributes->{
$name
};
if
(
defined
$node
)
{
$node
->setValue (
$val
);
}
else
{
$node
=
$self
->[_Doc]->createAttribute (
$name
,
$val
);
$self
->[_A]->setNamedItem (
$node
);
}
}
sub
setAttributeNode
{
my
(
$self
,
$node
) =
@_
;
my
$attr
=
$self
->getAttributes;
my
$name
=
$node
->getNodeName;
if
(
$XML::DOM::SafeMode
)
{
croak new XML::DOM::DOMException (WRONG_DOCUMENT_ERR,
"nodes belong to different documents"
)
if
$self
->[_Doc] !=
$node
->[_Doc];
croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR,
"node is ReadOnly"
)
if
$self
->isReadOnly;
my
$attrParent
=
$node
->[_UsedIn];
croak new XML::DOM::DOMException (INUSE_ATTRIBUTE_ERR,
"Attr is already used by another Element"
)
if
(
defined
(
$attrParent
) &&
$attrParent
!=
$attr
);
}
my
$other
=
$attr
->{
$name
};
$attr
->removeNamedItem (
$name
)
if
defined
$other
;
$attr
->setNamedItem (
$node
);
$other
;
}
sub
removeAttributeNode
{
my
(
$self
,
$node
) =
@_
;
croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR,
"node is ReadOnly"
)
if
$self
->isReadOnly;
my
$attr
=
$self
->[_A];
unless
(
defined
$attr
)
{
croak new XML::DOM::DOMException (NOT_FOUND_ERR);
return
undef
;
}
my
$name
=
$node
->getNodeName;
my
$attrNode
=
$attr
->getNamedItem (
$name
);
croak new XML::DOM::DOMException (NOT_FOUND_ERR)
unless
$node
==
$attrNode
;
return
undef
unless
$node
->isSpecified;
$attr
->removeNamedItem (
$name
);
my
$default
=
$self
->getDefaultAttrValue (
$name
);
if
(
defined
$default
)
{
local
$XML::DOM::IgnoreReadOnly
= 1;
$default
=
$default
->cloneNode (1);
$attr
->setNamedItem (
$default
);
}
$node
;
}
sub
removeAttribute
{
my
(
$self
,
$name
) =
@_
;
my
$attr
=
$self
->[_A];
unless
(
defined
$attr
)
{
croak new XML::DOM::DOMException (NOT_FOUND_ERR);
return
;
}
my
$node
=
$attr
->getNamedItem (
$name
);
if
(
defined
$node
)
{
$self
->removeAttributeNode (
$node
);
}
}
sub
cloneNode
{
my
(
$self
,
$deep
) =
@_
;
my
$node
=
$self
->[_Doc]->createElement (
$self
->getTagName);
if
(
defined
$self
->[_A])
{
$node
->[_A] =
$self
->[_A]->cloneNode (1);
$node
->[_A]->setParentNode (
$node
);
}
$node
->cloneChildren (
$self
,
$deep
);
$node
;
}
sub
getAttributes
{
$_
[0]->[_A] ||= XML::DOM::NamedNodeMap->new (
Doc
=>
$_
[0]->[_Doc],
Parent
=>
$_
[0]);
}
sub
setTagName
{
my
(
$self
,
$tagName
) =
@_
;
croak new XML::DOM::DOMException (INVALID_CHARACTER_ERR,
"bad Element TagName [$tagName]"
)
unless
XML::DOM::isValidName (
$tagName
);
$self
->[_TagName] =
$tagName
;
}
sub
isReadOnly
{
0;
}
sub
isElementNode
{
1;
}
sub
rejectChild
{
my
$t
=
$_
[1]->getNodeType;
$t
!= TEXT_NODE
&&
$t
!= ENTITY_REFERENCE_NODE
&&
$t
!= PROCESSING_INSTRUCTION_NODE
&&
$t
!= COMMENT_NODE
&&
$t
!= CDATA_SECTION_NODE
&&
$t
!= ELEMENT_NODE;
}
sub
getDefaultAttrValue
{
my
(
$self
,
$attr
) =
@_
;
$self
->[_Doc]->getDefaultAttrValue (
$self
->[_TagName],
$attr
);
}
sub
dispose
{
my
$self
=
shift
;
$self
->[_A]->dispose
if
defined
$self
->[_A];
$self
->SUPER::dispose;
}
sub
setOwnerDocument
{
my
(
$self
,
$doc
) =
@_
;
$self
->SUPER::setOwnerDocument (
$doc
);
$self
->[_A]->setOwnerDocument (
$doc
)
if
defined
$self
->[_A];
}
sub
print
{
my
(
$self
,
$FILE
) =
@_
;
my
$name
=
$self
->[_TagName];
$FILE
->
print
(
"<$name"
);
if
(
defined
$self
->[_A])
{
for
my
$att
(@{
$self
->[_A]->getValues})
{
if
(
$att
->isSpecified)
{
$FILE
->
print
(
" "
);
$att
->
print
(
$FILE
);
}
}
}
my
@kids
= @{
$self
->[_C]};
if
(
@kids
> 0)
{
$FILE
->
print
(
">"
);
for
my
$kid
(
@kids
)
{
$kid
->
print
(
$FILE
);
}
$FILE
->
print
(
"</$name>"
);
}
else
{
my
$style
=
&$XML::DOM::TagStyle
(
$name
,
$self
);
if
(
$style
== 0)
{
$FILE
->
print
(
"/>"
);
}
elsif
(
$style
== 1)
{
$FILE
->
print
(
"></$name>"
);
}
else
{
$FILE
->
print
(
" />"
);
}
}
}
sub
check
{
my
(
$self
,
$checker
) =
@_
;
die
"Usage: \$xml_dom_elem->check (\$checker)"
unless
$checker
;
$checker
->InitDomElem;
$self
->to_expat (
$checker
);
$checker
->FinalDomElem;
}
sub
to_expat
{
my
(
$self
,
$iter
) =
@_
;
my
$tag
=
$self
->getTagName;
$iter
->Start (
$tag
);
if
(
defined
$self
->[_A])
{
for
my
$attr
(
$self
->[_A]->getValues)
{
$iter
->Attr (
$tag
,
$attr
->getName,
$attr
->getValue,
$attr
->isSpecified);
}
}
$iter
->EndAttr;
for
my
$kid
(
$self
->getChildNodes)
{
$kid
->to_expat (
$iter
);
}
$iter
->End;
}
sub
_to_sax
{
my
(
$self
,
$doch
,
$dtdh
,
$enth
) =
@_
;
my
$tag
=
$self
->getTagName;
my
@attr
= ();
my
$attrOrder
;
my
$attrDefaulted
;
if
(
defined
$self
->[_A])
{
my
@spec
= ();
my
@unspec
= ();
for
my
$attr
(
$self
->[_A]->getValues)
{
my
$attrName
=
$attr
->getName;
push
@attr
,
$attrName
,
$attr
->getValue;
if
(
$attr
->isSpecified)
{
push
@spec
,
$attrName
;
}
else
{
push
@unspec
,
$attrName
;
}
}
$attrOrder
= [
@spec
,
@unspec
];
$attrDefaulted
=
@spec
;
}
$doch
->start_element (
defined
$attrOrder
?
{
Name
=>
$tag
,
Attributes
=> {
@attr
},
AttributeOrder
=>
$attrOrder
,
Defaulted
=>
$attrDefaulted
} :
{
Name
=>
$tag
,
Attributes
=> {
@attr
}
}
);
for
my
$kid
(
$self
->getChildNodes)
{
$kid
->_to_sax (
$doch
,
$dtdh
,
$enth
);
}
$doch
->end_element ( {
Name
=>
$tag
} );
}
use
vars
qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS }
;
BEGIN
{
import
XML::DOM::Node
qw( :DEFAULT :Fields )
;
XML::DOM::def_fields (
"Data"
,
"XML::DOM::Node"
);
}
sub
new
{
my
(
$class
,
$doc
,
$data
) =
@_
;
my
$self
=
bless
[],
$class
;
$self
->[_Doc] =
$doc
;
$self
->[_Data] =
$data
;
$self
;
}
sub
appendData
{
my
(
$self
,
$data
) =
@_
;
if
(
$XML::DOM::SafeMode
)
{
croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR,
"node is ReadOnly"
)
if
$self
->isReadOnly;
}
$self
->[_Data] .=
$data
;
}
sub
deleteData
{
my
(
$self
,
$offset
,
$count
) =
@_
;
croak new XML::DOM::DOMException (INDEX_SIZE_ERR,
"bad offset [$offset]"
)
if
(
$offset
< 0 ||
$offset
>=
length
(
$self
->[_Data]));
croak new XML::DOM::DOMException (INDEX_SIZE_ERR,
"negative count [$count]"
)
if
$count
< 0;
croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR,
"node is ReadOnly"
)
if
$self
->isReadOnly;
substr
(
$self
->[_Data],
$offset
,
$count
) =
""
;
}
sub
getData
{
$_
[0]->[_Data];
}
sub
getLength
{
length
$_
[0]->[_Data];
}
sub
insertData
{
my
(
$self
,
$offset
,
$data
) =
@_
;
croak new XML::DOM::DOMException (INDEX_SIZE_ERR,
"bad offset [$offset]"
)
if
(
$offset
< 0 ||
$offset
>=
length
(
$self
->[_Data]));
croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR,
"node is ReadOnly"
)
if
$self
->isReadOnly;
substr
(
$self
->[_Data],
$offset
, 0) =
$data
;
}
sub
replaceData
{
my
(
$self
,
$offset
,
$count
,
$data
) =
@_
;
croak new XML::DOM::DOMException (INDEX_SIZE_ERR,
"bad offset [$offset]"
)
if
(
$offset
< 0 ||
$offset
>=
length
(
$self
->[_Data]));
croak new XML::DOM::DOMException (INDEX_SIZE_ERR,
"negative count [$count]"
)
if
$count
< 0;
croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR,
"node is ReadOnly"
)
if
$self
->isReadOnly;
substr
(
$self
->[_Data],
$offset
,
$count
) =
$data
;
}
sub
setData
{
my
(
$self
,
$data
) =
@_
;
croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR,
"node is ReadOnly"
)
if
$self
->isReadOnly;
$self
->[_Data] =
$data
;
}
sub
substringData
{
my
(
$self
,
$offset
,
$count
) =
@_
;
my
$data
=
$self
->[_Data];
croak new XML::DOM::DOMException (INDEX_SIZE_ERR,
"bad offset [$offset]"
)
if
(
$offset
< 0 ||
$offset
>=
length
(
$data
));
croak new XML::DOM::DOMException (INDEX_SIZE_ERR,
"negative count [$count]"
)
if
$count
< 0;
substr
(
$data
,
$offset
,
$count
);
}
sub
getNodeValue
{
$_
[0]->getData;
}
sub
setNodeValue
{
$_
[0]->setData (
$_
[1]);
}
use
vars
qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS }
;
BEGIN
{
import
XML::DOM::CharacterData
qw( :DEFAULT :Fields )
;
import
XML::DOM::Node
qw( :DEFAULT :Fields )
;
XML::DOM::def_fields (
""
,
"XML::DOM::CharacterData"
);
}
sub
getNodeName
{
"#cdata-section"
;
}
sub
getNodeType
{
CDATA_SECTION_NODE;
}
sub
cloneNode
{
my
$self
=
shift
;
$self
->[_Doc]->createCDATASection (
$self
->getData);
}
sub
isReadOnly
{
0;
}
sub
print
{
my
(
$self
,
$FILE
) =
@_
;
$FILE
->
print
(
"<![CDATA["
);
$FILE
->
print
(XML::DOM::encodeCDATA (
$self
->getData));
$FILE
->
print
(
"]]>"
);
}
sub
to_expat
{
my
(
$self
,
$iter
) =
@_
;
$iter
->CData (
$self
->getData);
}
sub
_to_sax
{
my
(
$self
,
$doch
,
$dtdh
,
$enth
) =
@_
;
$doch
->start_cdata;
$doch
->characters ( {
Data
=>
$self
->getData } );
$doch
->end_cdata;
}
use
vars
qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS }
;
BEGIN
{
import
XML::DOM::CharacterData
qw( :DEFAULT :Fields )
;
import
XML::DOM::Node
qw( :DEFAULT :Fields )
;
XML::DOM::def_fields (
""
,
"XML::DOM::CharacterData"
);
}
sub
getNodeType
{
COMMENT_NODE;
}
sub
getNodeName
{
"#comment"
;
}
sub
cloneNode
{
my
$self
=
shift
;
$self
->[_Doc]->createComment (
$self
->getData);
}
sub
isReadOnly
{
return
0
if
$XML::DOM::IgnoreReadOnly
;
my
$pa
=
$_
[0]->[_Parent];
defined
(
$pa
) ?
$pa
->isReadOnly : 0;
}
sub
print
{
my
(
$self
,
$FILE
) =
@_
;
my
$comment
= XML::DOM::encodeComment (
$self
->[_Data]);
$FILE
->
print
(
"<!--$comment-->"
);
}
sub
to_expat
{
my
(
$self
,
$iter
) =
@_
;
$iter
->Comment (
$self
->getData);
}
sub
_to_sax
{
my
(
$self
,
$doch
,
$dtdh
,
$enth
) =
@_
;
$doch
->comment ( {
Data
=>
$self
->getData });
}
use
vars
qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS }
;
BEGIN
{
import
XML::DOM::CharacterData
qw( :DEFAULT :Fields )
;
import
XML::DOM::Node
qw( :DEFAULT :Fields )
;
XML::DOM::def_fields (
""
,
"XML::DOM::CharacterData"
);
}
sub
getNodeType
{
TEXT_NODE;
}
sub
getNodeName
{
"#text"
;
}
sub
splitText
{
my
(
$self
,
$offset
) =
@_
;
my
$data
=
$self
->getData;
croak new XML::DOM::DOMException (INDEX_SIZE_ERR,
"bad offset [$offset]"
)
if
(
$offset
< 0 ||
$offset
>=
length
(
$data
));
croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR,
"node is ReadOnly"
)
if
$self
->isReadOnly;
my
$rest
=
substr
(
$data
,
$offset
);
$self
->setData (
substr
(
$data
, 0,
$offset
));
my
$node
=
$self
->[_Doc]->createTextNode (
$rest
);
$self
->[_Parent]->insertBefore (
$node
,
$self
->getNextSibling);
$node
;
}
sub
cloneNode
{
my
$self
=
shift
;
$self
->[_Doc]->createTextNode (
$self
->getData);
}
sub
isReadOnly
{
0;
}
sub
print
{
my
(
$self
,
$FILE
) =
@_
;
$FILE
->
print
(XML::DOM::encodeText (
$self
->getData,
'<&>"'
));
}
sub
isTextNode
{
1;
}
sub
to_expat
{
my
(
$self
,
$iter
) =
@_
;
$iter
->Char (
$self
->getData);
}
sub
_to_sax
{
my
(
$self
,
$doch
,
$dtdh
,
$enth
) =
@_
;
$doch
->characters ( {
Data
=>
$self
->getData } );
}
use
vars
qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS }
;
BEGIN
{
import
XML::DOM::Node
qw( :DEFAULT :Fields )
;
XML::DOM::def_fields (
"Version Encoding Standalone"
,
"XML::DOM::Node"
);
}
sub
new
{
my
(
$class
,
$doc
,
$version
,
$encoding
,
$standalone
) =
@_
;
my
$self
=
bless
[],
$class
;
$self
->[_Doc] =
$doc
;
$self
->[_Version] =
$version
if
defined
$version
;
$self
->[_Encoding] =
$encoding
if
defined
$encoding
;
$self
->[_Standalone] =
$standalone
if
defined
$standalone
;
$self
;
}
sub
setVersion
{
if
(
defined
$_
[1])
{
$_
[0]->[_Version] =
$_
[1];
}
else
{
undef
$_
[0]->[_Version];
}
}
sub
getVersion
{
$_
[0]->[_Version];
}
sub
setEncoding
{
if
(
defined
$_
[1])
{
$_
[0]->[_Encoding] =
$_
[1];
}
else
{
undef
$_
[0]->[_Encoding];
}
}
sub
getEncoding
{
$_
[0]->[_Encoding];
}
sub
setStandalone
{
if
(
defined
$_
[1])
{
$_
[0]->[_Standalone] =
$_
[1];
}
else
{
undef
$_
[0]->[_Standalone];
}
}
sub
getStandalone
{
$_
[0]->[_Standalone];
}
sub
getNodeType
{
XML_DECL_NODE;
}
sub
cloneNode
{
my
$self
=
shift
;
new XML::DOM::XMLDecl (
$self
->[_Doc],
$self
->[_Version],
$self
->[_Encoding],
$self
->[_Standalone]);
}
sub
print
{
my
(
$self
,
$FILE
) =
@_
;
my
$version
=
$self
->[_Version];
my
$encoding
=
$self
->[_Encoding];
my
$standalone
=
$self
->[_Standalone];
$standalone
= (
$standalone
?
"yes"
:
"no"
)
if
defined
$standalone
;
$FILE
->
print
(
"<?xml"
);
$FILE
->
print
(
" version=\"$version\""
)
if
defined
$version
;
$FILE
->
print
(
" encoding=\"$encoding\""
)
if
defined
$encoding
;
$FILE
->
print
(
" standalone=\"$standalone\""
)
if
defined
$standalone
;
$FILE
->
print
(
"?>"
);
}
sub
to_expat
{
my
(
$self
,
$iter
) =
@_
;
$iter
->XMLDecl (
$self
->getVersion,
$self
->getEncoding,
$self
->getStandalone);
}
sub
_to_sax
{
my
(
$self
,
$doch
,
$dtdh
,
$enth
) =
@_
;
$dtdh
->xml_decl ( {
Version
=>
$self
->getVersion,
Encoding
=>
$self
->getEncoding,
Standalone
=>
$self
->getStandalone } );
}
use
vars
qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS }
;
BEGIN
{
import
XML::DOM::Node
qw( :DEFAULT :Fields )
;
XML::DOM::def_fields (
""
,
"XML::DOM::Node"
);
}
sub
new
{
my
(
$class
,
$doc
) =
@_
;
my
$self
=
bless
[],
$class
;
$self
->[_Doc] =
$doc
;
$self
->[_C] = new XML::DOM::NodeList;
$self
;
}
sub
getNodeType
{
DOCUMENT_FRAGMENT_NODE;
}
sub
getNodeName
{
"#document-fragment"
;
}
sub
cloneNode
{
my
(
$self
,
$deep
) =
@_
;
my
$node
=
$self
->[_Doc]->createDocumentFragment;
$node
->cloneChildren (
$self
,
$deep
);
$node
;
}
sub
isReadOnly
{
0;
}
sub
print
{
my
(
$self
,
$FILE
) =
@_
;
for
my
$node
(@{
$self
->[_C]})
{
$node
->
print
(
$FILE
);
}
}
sub
rejectChild
{
my
$t
=
$_
[1]->getNodeType;
$t
!= TEXT_NODE
&&
$t
!= ENTITY_REFERENCE_NODE
&&
$t
!= PROCESSING_INSTRUCTION_NODE
&&
$t
!= COMMENT_NODE
&&
$t
!= CDATA_SECTION_NODE
&&
$t
!= ELEMENT_NODE;
}
sub
isDocumentFragmentNode
{
1;
}
use
vars
qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS }
;
BEGIN
{
import
XML::DOM::Node
qw( :DEFAULT :Fields )
;
XML::DOM::def_fields (
"Doctype XmlDecl"
,
"XML::DOM::Node"
);
}
sub
new
{
my
(
$class
) =
@_
;
my
$self
=
bless
[],
$class
;
$self
->[_Doc] =
$self
;
$self
->[_C] = new XML::DOM::NodeList;
$self
;
}
sub
getNodeType
{
DOCUMENT_NODE;
}
sub
getNodeName
{
"#document"
;
}
sub
getDoctype
{
$_
[0]->[_Doctype];
}
sub
getDocumentElement
{
my
(
$self
) =
@_
;
for
my
$kid
(@{
$self
->[_C]})
{
return
$kid
if
$kid
->isElementNode;
}
undef
;
}
sub
getOwnerDocument
{
undef
;
}
sub
getImplementation
{
$XML::DOM::DOMImplementation::Singleton
;
}
sub
createAttribute
{
new XML::DOM::Attr (
@_
);
}
sub
createCDATASection
{
new XML::DOM::CDATASection (
@_
);
}
sub
createComment
{
new XML::DOM::Comment (
@_
);
}
sub
createElement
{
new XML::DOM::Element (
@_
);
}
sub
createTextNode
{
new XML::DOM::Text (
@_
);
}
sub
createProcessingInstruction
{
new XML::DOM::ProcessingInstruction (
@_
);
}
sub
createEntityReference
{
new XML::DOM::EntityReference (
@_
);
}
sub
createDocumentFragment
{
new XML::DOM::DocumentFragment (
@_
);
}
sub
createDocumentType
{
new XML::DOM::DocumentType (
@_
);
}
sub
cloneNode
{
my
(
$self
,
$deep
) =
@_
;
my
$node
= new XML::DOM::Document;
$node
->cloneChildren (
$self
,
$deep
);
my
$xmlDecl
=
$self
->[_XmlDecl];
$node
->[_XmlDecl] =
$xmlDecl
->cloneNode (
$deep
)
if
defined
$xmlDecl
;
$node
;
}
sub
appendChild
{
my
(
$self
,
$node
) =
@_
;
my
@nodes
= (
$node
);
@nodes
= @{
$node
->[_C]}
if
$node
->getNodeType == DOCUMENT_FRAGMENT_NODE;
my
$elem
= 0;
for
my
$n
(
@nodes
)
{
$elem
++
if
$n
->isElementNode;
}
if
(
$elem
> 0 &&
defined
(
$self
->getDocumentElement))
{
croak new XML::DOM::DOMException (HIERARCHY_REQUEST_ERR,
"document can have only one Element"
);
}
$self
->SUPER::appendChild (
$node
);
}
sub
insertBefore
{
my
(
$self
,
$node
,
$refNode
) =
@_
;
my
@nodes
= (
$node
);
@nodes
= @{
$node
->[_C]}
if
$node
->getNodeType == DOCUMENT_FRAGMENT_NODE;
my
$elem
= 0;
for
my
$n
(
@nodes
)
{
$elem
++
if
$n
->isElementNode;
}
if
(
$elem
> 0 &&
defined
(
$self
->getDocumentElement))
{
croak new XML::DOM::DOMException (HIERARCHY_REQUEST_ERR,
"document can have only one Element"
);
}
$self
->SUPER::insertBefore (
$node
,
$refNode
);
}
sub
replaceChild
{
my
(
$self
,
$node
,
$refNode
) =
@_
;
my
@nodes
= (
$node
);
@nodes
= @{
$node
->[_C]}
if
$node
->getNodeType == DOCUMENT_FRAGMENT_NODE;
my
$elem
= 0;
$elem
--
if
$refNode
->isElementNode;
for
my
$n
(
@nodes
)
{
$elem
++
if
$n
->isElementNode;
}
if
(
$elem
> 0 &&
defined
(
$self
->getDocumentElement))
{
croak new XML::DOM::DOMException (HIERARCHY_REQUEST_ERR,
"document can have only one Element"
);
}
$self
->SUPER::replaceChild (
$node
,
$refNode
);
}
sub
isReadOnly
{
0;
}
sub
print
{
my
(
$self
,
$FILE
) =
@_
;
my
$xmlDecl
=
$self
->getXMLDecl;
if
(
defined
$xmlDecl
)
{
$xmlDecl
->
print
(
$FILE
);
$FILE
->
print
(
"\x0A"
);
}
for
my
$node
(@{
$self
->[_C]})
{
$node
->
print
(
$FILE
);
$FILE
->
print
(
"\x0A"
);
}
}
sub
setDoctype
{
my
(
$self
,
$doctype
) =
@_
;
my
$oldDoctype
=
$self
->[_Doctype];
if
(
defined
$oldDoctype
)
{
$self
->replaceChild (
$doctype
,
$oldDoctype
);
}
else
{
$self
->appendChild (
$doctype
);
}
$_
[0]->[_Doctype] =
$_
[1];
}
sub
removeDoctype
{
my
$self
=
shift
;
my
$doctype
=
$self
->removeChild (
$self
->[_Doctype]);
undef
$self
->[_Doctype];
$doctype
;
}
sub
rejectChild
{
my
$t
=
$_
[1]->getNodeType;
$t
!= ELEMENT_NODE
&&
$t
!= PROCESSING_INSTRUCTION_NODE
&&
$t
!= COMMENT_NODE
&&
$t
!= DOCUMENT_TYPE_NODE;
}
sub
expandEntity
{
my
(
$self
,
$ent
,
$param
) =
@_
;
my
$doctype
=
$self
->getDoctype;
(
defined
$doctype
) ?
$doctype
->expandEntity (
$ent
,
$param
) :
undef
;
}
sub
getDefaultAttrValue
{
my
(
$self
,
$elem
,
$attr
) =
@_
;
my
$doctype
=
$self
->getDoctype;
(
defined
$doctype
) ?
$doctype
->getDefaultAttrValue (
$elem
,
$attr
) :
undef
;
}
sub
getEntity
{
my
(
$self
,
$entity
) =
@_
;
my
$doctype
=
$self
->getDoctype;
(
defined
$doctype
) ?
$doctype
->getEntity (
$entity
) :
undef
;
}
sub
dispose
{
my
$self
=
shift
;
$self
->[_XmlDecl]->dispose
if
defined
$self
->[_XmlDecl];
undef
$self
->[_XmlDecl];
undef
$self
->[_Doctype];
$self
->SUPER::dispose;
}
sub
setOwnerDocument
{
}
sub
getXMLDecl
{
$_
[0]->[_XmlDecl];
}
sub
setXMLDecl
{
$_
[0]->[_XmlDecl] =
$_
[1];
}
sub
createXMLDecl
{
new XML::DOM::XMLDecl (
@_
);
}
sub
createNotation
{
new XML::DOM::Notation (
@_
);
}
sub
createElementDecl
{
new XML::DOM::ElementDecl (
@_
);
}
sub
createAttlistDecl
{
new XML::DOM::AttlistDecl (
@_
);
}
sub
createEntity
{
new XML::DOM::Entity (
@_
);
}
sub
createChecker
{
my
$self
=
shift
;
my
$checker
= XML::Checker->new;
$checker
->Init;
my
$doctype
=
$self
->getDoctype;
$doctype
->to_expat (
$checker
)
if
$doctype
;
$checker
->Final;
$checker
;
}
sub
check
{
my
(
$self
,
$checker
) =
@_
;
$checker
||= XML::Checker->new;
$self
->to_expat (
$checker
);
}
sub
to_expat
{
my
(
$self
,
$iter
) =
@_
;
$iter
->Init;
for
my
$kid
(
$self
->getChildNodes)
{
$kid
->to_expat (
$iter
);
}
$iter
->Final;
}
sub
check_sax
{
my
(
$self
,
$checker
) =
@_
;
$checker
||= XML::Checker->new;
$self
->to_sax (
Handler
=>
$checker
);
}
sub
_to_sax
{
my
(
$self
,
$doch
,
$dtdh
,
$enth
) =
@_
;
$doch
->start_document;
for
my
$kid
(
$self
->getChildNodes)
{
$kid
->_to_sax (
$doch
,
$dtdh
,
$enth
);
}
$doch
->end_document;
}
use
vars
qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS }
;
BEGIN
{
import
XML::DOM::Node
qw( :DEFAULT :Fields )
;
import
XML::DOM::Document
qw( :Fields )
;
XML::DOM::def_fields (
"Entities Notations Name SysId PubId Internal"
,
"XML::DOM::Node"
);
}
sub
new
{
my
$class
=
shift
;
my
$doc
=
shift
;
my
$self
=
bless
[],
$class
;
$self
->[_Doc] =
$doc
;
$self
->[_ReadOnly] = 1;
$self
->[_C] = new XML::DOM::NodeList;
$self
->[_Entities] = new XML::DOM::NamedNodeMap (
Doc
=>
$doc
,
Parent
=>
$self
,
ReadOnly
=> 1);
$self
->[_Notations] = new XML::DOM::NamedNodeMap (
Doc
=>
$doc
,
Parent
=>
$self
,
ReadOnly
=> 1);
$self
->setParams (
@_
);
$self
;
}
sub
getNodeType
{
DOCUMENT_TYPE_NODE;
}
sub
getNodeName
{
$_
[0]->[_Name];
}
sub
getName
{
$_
[0]->[_Name];
}
sub
getEntities
{
$_
[0]->[_Entities];
}
sub
getNotations
{
$_
[0]->[_Notations];
}
sub
setParentNode
{
my
(
$self
,
$parent
) =
@_
;
$self
->SUPER::setParentNode (
$parent
);
$parent
->[_Doctype] =
$self
if
$parent
->getNodeType == DOCUMENT_NODE;
}
sub
cloneNode
{
my
(
$self
,
$deep
) =
@_
;
my
$node
= new XML::DOM::DocumentType (
$self
->[_Doc],
$self
->[_Name],
$self
->[_SysId],
$self
->[_PubId],
$self
->[_Internal]);
$node
->[_Entities] =
$self
->[_Entities]->cloneNode (
$deep
);
$node
->[_Notations] =
$self
->[_Notations]->cloneNode (
$deep
);
$node
->cloneChildren (
$self
,
$deep
);
$node
;
}
sub
getSysId
{
$_
[0]->[_SysId];
}
sub
getPubId
{
$_
[0]->[_PubId];
}
sub
getInternal
{
$_
[0]->[_Internal];
}
sub
setSysId
{
$_
[0]->[_SysId] =
$_
[1];
}
sub
setPubId
{
$_
[0]->[_PubId] =
$_
[1];
}
sub
setInternal
{
$_
[0]->[_Internal] =
$_
[1];
}
sub
setName
{
$_
[0]->[_Name] =
$_
[1];
}
sub
removeChildHoodMemories
{
my
(
$self
,
$dontWipeReadOnly
) =
@_
;
my
$parent
=
$self
->[_Parent];
if
(
defined
$parent
&&
$parent
->getNodeType == DOCUMENT_NODE)
{
undef
$parent
->[_Doctype];
}
$self
->SUPER::removeChildHoodMemories;
}
sub
dispose
{
my
$self
=
shift
;
$self
->[_Entities]->dispose;
$self
->[_Notations]->dispose;
$self
->SUPER::dispose;
}
sub
setOwnerDocument
{
my
(
$self
,
$doc
) =
@_
;
$self
->SUPER::setOwnerDocument (
$doc
);
$self
->[_Entities]->setOwnerDocument (
$doc
);
$self
->[_Notations]->setOwnerDocument (
$doc
);
}
sub
expandEntity
{
my
(
$self
,
$ent
,
$param
) =
@_
;
my
$kid
=
$self
->[_Entities]->getNamedItem (
$ent
);
return
$kid
->getValue
if
(
defined
(
$kid
) &&
$param
==
$kid
->isParameterEntity);
undef
;
}
sub
getAttlistDecl
{
my
(
$self
,
$elemName
) =
@_
;
for
my
$kid
(@{
$_
[0]->[_C]})
{
return
$kid
if
(
$kid
->getNodeType == ATTLIST_DECL_NODE &&
$kid
->getName eq
$elemName
);
}
undef
;
}
sub
getElementDecl
{
my
(
$self
,
$elemName
) =
@_
;
for
my
$kid
(@{
$_
[0]->[_C]})
{
return
$kid
if
(
$kid
->getNodeType == ELEMENT_DECL_NODE &&
$kid
->getName eq
$elemName
);
}
undef
;
}
sub
addElementDecl
{
my
(
$self
,
$name
,
$model
,
$hidden
) =
@_
;
my
$node
=
$self
->getElementDecl (
$name
);
unless
(
defined
$node
)
{
$node
=
$self
->[_Doc]->createElementDecl (
$name
,
$model
,
$hidden
);
$self
->appendChild (
$node
);
}
$node
;
}
sub
addAttlistDecl
{
my
(
$self
,
$name
) =
@_
;
my
$node
=
$self
->getAttlistDecl (
$name
);
unless
(
defined
$node
)
{
$node
=
$self
->[_Doc]->createAttlistDecl (
$name
);
$self
->appendChild (
$node
);
}
$node
;
}
sub
addNotation
{
my
$self
=
shift
;
my
$node
=
$self
->[_Doc]->createNotation (
@_
);
$self
->[_Notations]->setNamedItem (
$node
);
$node
;
}
sub
addEntity
{
my
$self
=
shift
;
my
$node
=
$self
->[_Doc]->createEntity (
@_
);
$self
->[_Entities]->setNamedItem (
$node
);
$node
;
}
sub
addAttDef
{
my
$self
=
shift
;
my
$elemName
=
shift
;
my
$attListDecl
=
$self
->addAttlistDecl (
$elemName
);
$attListDecl
->addAttDef (
@_
);
}
sub
getDefaultAttrValue
{
my
(
$self
,
$elem
,
$attr
) =
@_
;
my
$elemNode
=
$self
->getAttlistDecl (
$elem
);
(
defined
$elemNode
) ?
$elemNode
->getDefaultAttrValue (
$attr
) :
undef
;
}
sub
getEntity
{
my
(
$self
,
$entity
) =
@_
;
$self
->[_Entities]->getNamedItem (
$entity
);
}
sub
setParams
{
my
(
$self
,
$name
,
$sysid
,
$pubid
,
$internal
) =
@_
;
$self
->[_Name] =
$name
;
$self
->[_SysId] =
$sysid
if
defined
$sysid
;
$self
->[_PubId] =
$pubid
if
defined
$pubid
;
$self
->[_Internal] =
$internal
if
defined
$internal
;
$self
;
}
sub
rejectChild
{
not
$XML::DOM::IgnoreReadOnly
;
}
sub
print
{
my
(
$self
,
$FILE
) =
@_
;
my
$name
=
$self
->[_Name];
my
$sysId
=
$self
->[_SysId];
my
$pubId
=
$self
->[_PubId];
$FILE
->
print
(
"<!DOCTYPE $name"
);
if
(
defined
$pubId
)
{
$FILE
->
print
(
" PUBLIC \"$pubId\" \"$sysId\""
);
}
elsif
(
defined
$sysId
)
{
$FILE
->
print
(
" SYSTEM \"$sysId\""
);
}
my
@entities
= @{
$self
->[_Entities]->getValues};
my
@notations
= @{
$self
->[_Notations]->getValues};
my
@kids
= @{
$self
->[_C]};
if
(
@entities
||
@notations
||
@kids
)
{
$FILE
->
print
(
" [\x0A"
);
for
my
$kid
(
@entities
)
{
next
if
$kid
->[_Hidden];
$FILE
->
print
(
" "
);
$kid
->
print
(
$FILE
);
$FILE
->
print
(
"\x0A"
);
}
for
my
$kid
(
@notations
)
{
next
if
$kid
->[_Hidden];
$FILE
->
print
(
" "
);
$kid
->
print
(
$FILE
);
$FILE
->
print
(
"\x0A"
);
}
for
my
$kid
(
@kids
)
{
next
if
$kid
->[_Hidden];
$FILE
->
print
(
" "
);
$kid
->
print
(
$FILE
);
$FILE
->
print
(
"\x0A"
);
}
$FILE
->
print
(
"]"
);
}
$FILE
->
print
(
">"
);
}
sub
to_expat
{
my
(
$self
,
$iter
) =
@_
;
$iter
->Doctype (
$self
->getName,
$self
->getSysId,
$self
->getPubId,
$self
->getInternal);
for
my
$ent
(
$self
->getEntities->getValues)
{
next
if
$ent
->[_Hidden];
$ent
->to_expat (
$iter
);
}
for
my
$nota
(
$self
->getNotations->getValues)
{
next
if
$nota
->[_Hidden];
$nota
->to_expat (
$iter
);
}
for
my
$kid
(
$self
->getChildNodes)
{
next
if
$kid
->[_Hidden];
$kid
->to_expat (
$iter
);
}
}
sub
_to_sax
{
my
(
$self
,
$doch
,
$dtdh
,
$enth
) =
@_
;
$dtdh
->doctype_decl ( {
Name
=>
$self
->getName,
SystemId
=>
$self
->getSysId,
PublicId
=>
$self
->getPubId,
Internal
=>
$self
->getInternal });
for
my
$ent
(
$self
->getEntities->getValues)
{
next
if
$ent
->[_Hidden];
$ent
->_to_sax (
$doch
,
$dtdh
,
$enth
);
}
for
my
$nota
(
$self
->getNotations->getValues)
{
next
if
$nota
->[_Hidden];
$nota
->_to_sax (
$doch
,
$dtdh
,
$enth
);
}
for
my
$kid
(
$self
->getChildNodes)
{
next
if
$kid
->[_Hidden];
$kid
->_to_sax (
$doch
,
$dtdh
,
$enth
);
}
}
@ISA
=
qw( XML::Parser )
;
sub
new
{
my
(
$class
,
%args
) =
@_
;
$args
{Style} =
'XML::Parser::Dom'
;
$class
->SUPER::new (
%args
);
}
sub
parse
{
my
$self
=
shift
;
local
$XML::Parser::Dom::_DP_doc
;
local
$XML::Parser::Dom::_DP_elem
;
local
$XML::Parser::Dom::_DP_doctype
;
local
$XML::Parser::Dom::_DP_in_prolog
;
local
$XML::Parser::Dom::_DP_end_doc
;
local
$XML::Parser::Dom::_DP_saw_doctype
;
local
$XML::Parser::Dom::_DP_in_CDATA
;
local
$XML::Parser::Dom::_DP_keep_CDATA
;
local
$XML::Parser::Dom::_DP_last_text
;
local
$XML::DOM::SafeMode
= 0;
local
$XML::DOM::IgnoreReadOnly
= 1;
my
$ret
;
eval
{
$ret
=
$self
->SUPER::parse (
@_
);
};
my
$err
= $@;
if
(
$err
)
{
my
$doc
=
$XML::Parser::Dom::_DP_doc
;
if
(
$doc
)
{
$doc
->dispose;
}
die
$err
;
}
$ret
;
}
my
$LWP_USER_AGENT
;
sub
set_LWP_UserAgent
{
$LWP_USER_AGENT
=
shift
;
}
sub
parsefile
{
my
$self
=
shift
;
my
$url
=
shift
;
if
(
$url
=~ /^(https?|ftp|wais|gopher|file):/)
{
my
$result
;
eval
{
my
$ua
=
$self
->{LWP_UserAgent};
unless
(
defined
$ua
)
{
unless
(
defined
$LWP_USER_AGENT
)
{
$LWP_USER_AGENT
= LWP::UserAgent->new;
$LWP_USER_AGENT
->env_proxy;
}
$ua
=
$LWP_USER_AGENT
;
}
my
$req
= new HTTP::Request
'GET'
,
$url
;
my
$response
=
$ua
->request (
$req
);
$result
=
$self
->parse (
$response
->content,
@_
);
};
if
($@)
{
die
"Couldn't parsefile [$url] with LWP: $@"
;
}
return
$result
;
}
else
{
return
$self
->SUPER::parsefile (
$url
,
@_
);
}
}
BEGIN
{
import
XML::DOM::Node
qw( :Fields )
;
import
XML::DOM::CharacterData
qw( :Fields )
;
}
$_DP_elem
$_DP_doctype
$_DP_in_prolog
$_DP_end_doc
$_DP_saw_doctype
$_DP_in_CDATA
$_DP_keep_CDATA
$_DP_last_text
$_DP_level
$_DP_expand_pent
)
;
$XML::Parser::Built_In_Styles
{Dom} = 1;
sub
Init
{
$_DP_elem
=
$_DP_doc
= new XML::DOM::Document();
$_DP_doctype
= new XML::DOM::DocumentType (
$_DP_doc
);
$_DP_doc
->setDoctype (
$_DP_doctype
);
$_DP_keep_CDATA
=
$_
[0]->{KeepCDATA};
$_DP_in_prolog
= 1;
$_DP_end_doc
= 0;
$_DP_expand_pent
=
defined
$_
[0]->{ExpandParamEnt} ?
$_
[0]->{ExpandParamEnt} : 1;
if
(
$_DP_expand_pent
)
{
$_
[0]->{DOM_Entity} = {};
}
$_DP_level
= 0;
undef
$_DP_last_text
;
}
sub
Final
{
unless
(
$_DP_saw_doctype
)
{
my
$doctype
=
$_DP_doc
->removeDoctype;
$doctype
->dispose;
}
$_DP_doc
;
}
sub
Char
{
my
$str
=
$_
[1];
if
(
$_DP_in_CDATA
&&
$_DP_keep_CDATA
)
{
undef
$_DP_last_text
;
$_DP_elem
->addCDATA (
$str
);
}
else
{
if
(
$_DP_last_text
)
{
$_DP_last_text
->[_Data] .=
$str
;
}
else
{
$_DP_last_text
=
$_DP_doc
->createTextNode (
$str
);
$_DP_last_text
->[_Parent] =
$_DP_elem
;
push
@{
$_DP_elem
->[_C]},
$_DP_last_text
;
}
}
}
sub
Start
{
my
(
$expat
,
$elem
,
@attr
) =
@_
;
my
$parent
=
$_DP_elem
;
my
$doc
=
$_DP_doc
;
if
(
$parent
==
$doc
)
{
$_DP_in_prolog
= 0;
}
undef
$_DP_last_text
;
my
$node
=
$doc
->createElement (
$elem
);
$_DP_elem
=
$node
;
$parent
->appendChild (
$node
);
my
$n
=
@attr
;
return
unless
$n
;
my
$first_default
=
$expat
->specified_attr;
my
$i
= 0;
while
(
$i
<
$n
)
{
my
$specified
=
$i
<
$first_default
;
my
$name
=
$attr
[
$i
++];
undef
$_DP_last_text
;
my
$attr
=
$doc
->createAttribute (
$name
,
$attr
[
$i
++],
$specified
);
$node
->setAttributeNode (
$attr
);
}
}
sub
End
{
$_DP_elem
=
$_DP_elem
->[_Parent];
undef
$_DP_last_text
;
$_DP_end_doc
= 1
if
(
$_DP_elem
==
$_DP_doc
);
}
sub
Default
{
my
(
$expat
,
$str
) =
@_
;
if
(
$_DP_in_prolog
)
{
}
elsif
(!
$_DP_end_doc
)
{
return
unless
$str
=~ s!^&!!;
return
unless
$str
=~ s!;$!!;
$_DP_elem
->appendChild (
$_DP_doc
->createEntityReference (
$str
,0,
$expat
->{NoExpand}));
undef
$_DP_last_text
;
}
}
sub
CdataStart
{
$_DP_in_CDATA
= 1;
}
sub
CdataEnd
{
$_DP_in_CDATA
= 0;
}
my
$START_MARKER
=
"__DOM__START__ENTITY__"
;
my
$END_MARKER
=
"__DOM__END__ENTITY__"
;
sub
Comment
{
undef
$_DP_last_text
;
if
(
$_
[1] =~ /(?:(
$START_MARKER
)|(
$END_MARKER
))/)
{
if
($1)
{
$_DP_level
++;
}
else
{
$_DP_level
--;
}
}
else
{
my
$comment
=
$_DP_doc
->createComment (
$_
[1]);
$_DP_elem
->appendChild (
$comment
);
}
}
sub
deb
{
my
$name
=
shift
;
print
"$name ("
.
join
(
","
,
map
{
defined
(
$_
)?
$_
:
"(undef)"
}
@_
) .
")\n"
;
}
sub
Doctype
{
my
$expat
=
shift
;
$_DP_doctype
->setParams (
@_
);
$_DP_saw_doctype
= 1;
}
sub
Attlist
{
my
$expat
=
shift
;
$_
[5] =
"Hidden"
unless
$_DP_expand_pent
||
$_DP_level
== 0;
$_DP_doctype
->addAttDef (
@_
);
}
sub
XMLDecl
{
my
$expat
=
shift
;
undef
$_DP_last_text
;
$_DP_doc
->setXMLDecl (new XML::DOM::XMLDecl (
$_DP_doc
,
@_
));
}
sub
Entity
{
my
$expat
=
shift
;
if
(
$_
[5])
{
if
(
defined
$_
[2])
{
if
(
exists
$expat
->{DOM_Entity}->{
$_
[2]})
{
XML::DOM::warning (
"Entity $_[2] is known as %$_[0] and %"
.
$expat
->{DOM_Entity}->{
$_
[2]});
}
else
{
$expat
->{DOM_Entity}->{
$_
[2]} =
$_
[0];
}
}
}
if
(
defined
$_
[2] &&
defined
$_
[1])
{
$_
[1] =
undef
;
}
undef
$_DP_last_text
;
$_
[6] =
"Hidden"
unless
$_DP_expand_pent
||
$_DP_level
== 0;
$_DP_doctype
->addEntity (
@_
);
}
sub
Unparsed
{
Entity (
@_
);
}
sub
Element
{
shift
;
$_
[1] =
"$_[1]"
;
undef
$_DP_last_text
;
push
@_
,
"Hidden"
unless
$_DP_expand_pent
||
$_DP_level
== 0;
$_DP_doctype
->addElementDecl (
@_
);
}
sub
Notation
{
shift
;
undef
$_DP_last_text
;
$_
[4] =
"Hidden"
unless
$_DP_expand_pent
||
$_DP_level
== 0;
$_DP_doctype
->addNotation (
@_
);
}
sub
Proc
{
shift
;
undef
$_DP_last_text
;
push
@_
,
"Hidden"
unless
$_DP_expand_pent
||
$_DP_level
== 0;
$_DP_elem
->appendChild (
$_DP_doc
->createProcessingInstruction (
@_
));
}
sub
ExternEnt
{
my
(
$expat
,
$base
,
$sysid
,
$pubid
) =
@_
;
my
$content
;
if
(
$XML::Parser::have_LWP
)
{
$content
= XML::Parser::lwp_ext_ent_handler (
@_
);
}
else
{
$content
= XML::Parser::file_ext_ent_handler (
@_
);
}
if
(
$_DP_expand_pent
)
{
return
$content
;
}
else
{
my
$entname
=
$expat
->{DOM_Entity}->{
$sysid
};
if
(
defined
$entname
)
{
$_DP_doctype
->appendChild (
$_DP_doc
->createEntityReference (
$entname
, 1,
$expat
->{NoExpand}));
return
"<!-- $START_MARKER sysid=[$sysid] -->"
.
$content
.
"<!-- $END_MARKER sysid=[$sysid] -->"
;
}
else
{
return
"<!-- $START_MARKER sysid=[DTD] -->"
.
$content
.
"<!-- $END_MARKER sysid=[DTD] -->"
;
}
}
}
1;
Hide Show 426 lines of Pod