package Tree::Template::Declare::LibXML;
use strict;
use warnings;
use Carp;
use XML::LibXML;
sub new {
my ($class)=@_;
return bless {ns=>{':default'=>undef}},$class;
}
sub _munge_exports {
my ($self,$exports)=@_;
return {
%$exports,
xmlns => sub($$) {
$self->{ns}->{$_[0]}=$_[1];
return;
},
};
}
sub new_tree {
my ($self)=@_;
return XML::LibXML::Document->new();
}
sub finalize_tree {
my ($self,$tree)=@_;
return $tree;
}
sub _get_ns {
my ($self,$name)=@_;
my ($prefix)=($name=~m{\A (.*?) : }smx);
if (!defined($prefix) or length($prefix)==0) {
return '',$self->{ns}->{':default'};
}
if (exists $self->{ns}->{$prefix}) {
return $prefix, $self->{ns}->{$prefix};
}
return;
}
sub new_node {
my ($self)=@_;
return XML::LibXML::Element->new('');
}
sub add_child_node {
my ($self,$parent,$child)=@_;
my $doc=$parent->ownerDocument;
$child=$doc->adoptNode($child) if $doc;
if ($parent->isa('XML::LibXML::Document')) {
$parent->setDocumentElement($child);
}
else {
$parent->appendChild($child);
}
return $parent;
}
sub set_node_name {
my ($self,$node,$name)=@_;
$node->setNodeName($name);
my ($prefix,$uri)=$self->_get_ns($name);
if ($uri) {
$node->setNamespace($uri,$prefix,1);
}
}
sub set_node_attributes {
my ($self,$node,$attrs)=@_;
while (my ($name,$val)=each %$attrs) {
my ($prefix,$uri)=$self->_get_ns($name);
if ($prefix and $uri) {
$node->setAttributeNS($uri, $name, $val);
}
else {
$node->setAttribute($name, $val);
}
}
return;
}
1;
__END__