$VERSION
=
'1.27'
;
use
vars
qw/$xmlns_ns $xml_ns/
;
sub
new {
my
$class
=
shift
;
my
$self
= (
$#_
== 0) ? { %{ (
shift
) } } : {
@_
};
bless
$self
,
$class
;
}
sub
start_document {
my
$self
=
shift
;
$self
->{IdNames} = {};
$self
->{InScopeNamespaceStack} = [ {
'_Default'
=>
undef
,
'xmlns'
=>
$xmlns_ns
,
'xml'
=>
$xml_ns
,
} ];
$self
->{NodeStack} = [ ];
my
$document
= XML::XPath::Node::Element->new();
my
$newns
= XML::XPath::Node::Namespace->new(
'xml'
,
$xml_ns
);
$document
->appendNamespace(
$newns
);
$self
->{current} =
$self
->{DOC_Node} =
$document
;
}
sub
end_document {
my
$self
=
shift
;
return
$self
->{DOC_Node};
}
sub
characters {
my
$self
=
shift
;
my
$sarg
=
shift
;
my
$text
=
$sarg
->{Data};
my
$parent
=
$self
->{current};
my
$last
=
$parent
->getLastChild;
if
(
$last
&&
$last
->isTextNode) {
$last
->appendText(
$text
);
return
;
}
my
$node
= XML::XPath::Node::Text->new(
$text
);
$parent
->appendChild(
$node
, 1);
}
sub
start_element {
my
$self
=
shift
;
my
$sarg
=
shift
;
my
$tag
=
$sarg
->{
'Name'
};
my
$attr
=
$sarg
->{
'Attributes'
};
push
@{
$self
->{InScopeNamespaceStack} },
{ %{
$self
->{InScopeNamespaceStack}[-1] } };
$self
->_scan_namespaces(
@_
);
my
(
$prefix
,
$namespace
) =
$self
->_namespace(
$tag
);
my
$node
= XML::XPath::Node::Element->new(
$tag
,
$prefix
);
foreach
my
$name
(
keys
%$attr
) {
my
$value
=
$attr
->{
$name
};
if
(
$name
=~ /^xmlns(:(.*))?$/) {
my
$prefix
= $2 ||
'#default'
;
my
$newns
= XML::XPath::Node::Namespace->new(
$prefix
,
$value
);
$node
->appendNamespace(
$newns
);
}
else
{
my
(
$prefix
,
$namespace
) =
$self
->_namespace(
$name
);
undef
$namespace
unless
$prefix
;
my
$newattr
= XML::XPath::Node::Attribute->new(
$name
,
$value
,
$prefix
);
$node
->appendAttribute(
$newattr
, 1);
if
(
exists
(
$self
->{IdNames}{
$tag
}) && (
$self
->{IdNames}{
$tag
} eq
$name
)) {
$self
->{DOC_Node}->appendIdElement(
$value
,
$node
);
}
}
}
$self
->{current}->appendChild(
$node
, 1);
$self
->{current} =
$node
;
}
sub
end_element {
my
$self
=
shift
;
$self
->{current} =
$self
->{current}->getParentNode;
}
sub
processing_instruction {
my
$self
=
shift
;
my
$pi
=
shift
;
my
$node
= XML::XPath::Node::PI->new(
$pi
->{Target},
$pi
->{Data});
$self
->{current}->appendChild(
$node
, 1);
}
sub
comment {
my
$self
=
shift
;
my
$comment
=
shift
;
my
$node
= XML::XPath::Node::Comment->new(
$comment
->{Data});
$self
->{current}->appendChild(
$node
, 1);
}
sub
_scan_namespaces {
my
(
$self
,
%attributes
) =
@_
;
while
(
my
(
$attr_name
,
$value
) =
each
%attributes
) {
if
(
$attr_name
eq
'xmlns'
) {
$self
->{InScopeNamespaceStack}[-1]{
'_Default'
} =
$value
;
}
elsif
(
$attr_name
=~ /^xmlns:(.*)$/) {
my
$prefix
= $1;
$self
->{InScopeNamespaceStack}[-1]{
$prefix
} =
$value
;
}
}
}
sub
_namespace {
my
(
$self
,
$name
) =
@_
;
my
(
$prefix
,
$localname
) =
split
(/:/,
$name
);
if
(!
defined
(
$localname
)) {
if
(
$prefix
eq
'xmlns'
) {
return
''
,
undef
;
}
else
{
return
''
,
$self
->{InScopeNamespaceStack}[-1]{
'_Default'
};
}
}
else
{
return
$prefix
,
$self
->{InScopeNamespaceStack}[-1]{
$prefix
};
}
}
1;