lib/Tree/Template/Declare/LibXML.pm


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124

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__
 
=head1 NAME
 
Tree::Template::Declare::LibXML
 
=head1 SYNOPSIS
 
See L<Tree::Template::Declare>.
 
=head1 SPECIFICITIES
 
A function C<xmlns> is exported, so that you can declare XML namespaces:
 
  xmlns test => 'http://test/';
 
  node { name 'test:elem'; attribs id => 1, 'test:attr' => 5 };
 
You I<can> create nodes with qualified names with undeclared prefixes,
but it's probably not a good idea.
 
=head1 AUTHOR
 
Gianni Ceccarelli <dakkar@thenautilus.net>
 
=cut