From 26248672c6b3ee8f8b10dff5f2b8302e008f46c1 Mon Sep 17 00:00:00 2001 From: Gianni Ceccarelli Date: Fri, 27 Mar 2009 13:00:46 +0100 Subject: LibXML with namespace support, and fixed tests --- lib/Tree/Template/Declare.pm | 6 +++++ lib/Tree/Template/Declare/LibXML.pm | 42 ++++++++++++++++++++++++++++++--- t/02-xslt.t | 9 ++++++- t/03-html.t | 5 +++- t/04-xml.t | 47 +++++++++++++++++++++++++++---------- 5 files changed, 91 insertions(+), 18 deletions(-) diff --git a/lib/Tree/Template/Declare.pm b/lib/Tree/Template/Declare.pm index 9778f42..a2be8e2 100644 --- a/lib/Tree/Template/Declare.pm +++ b/lib/Tree/Template/Declare.pm @@ -45,6 +45,11 @@ sub _build_group { } } + my $additional_exports={}; + if ($builder->can('_additional_exports')) { + $additional_exports=$builder->_additional_exports(); + } + my @current_node=(undef); return { @@ -76,6 +81,7 @@ sub _build_group { $builder->set_node_attributes($current_node[0],\%attrs); return; }, + %$additional_exports, }; } diff --git a/lib/Tree/Template/Declare/LibXML.pm b/lib/Tree/Template/Declare/LibXML.pm index 7be3fe8..f8c0e01 100644 --- a/lib/Tree/Template/Declare/LibXML.pm +++ b/lib/Tree/Template/Declare/LibXML.pm @@ -7,7 +7,18 @@ use XML::LibXML; sub new { my ($class)=@_; - return bless {},$class; + return bless {ns=>{':default'=>undef}},$class; +} + +sub _additional_exports { + my ($self)=@_; + + return { + xmlns => sub($$) { + $self->{ns}->{$_[0]}=$_[1]; + return; + }, + }; } sub new_tree { @@ -22,6 +33,21 @@ sub finalize_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)=@_; @@ -46,14 +72,24 @@ sub add_child_node { sub set_node_name { my ($self,$node,$name)=@_; - return $node->setNodeName($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) { - $node->setAttribute($name, $val); + my ($prefix,$uri)=$self->_get_ns($name); + if ($prefix and $uri) { + $node->setAttributeNS($uri, $name, $val); + } + else { + $node->setAttribute($name, $val); + } } return; } diff --git a/t/02-xslt.t b/t/02-xslt.t index e47572b..49e617a 100644 --- a/t/02-xslt.t +++ b/t/02-xslt.t @@ -1,4 +1,10 @@ #!perl +package main; +use Test::Most 'die'; +BEGIN { +eval 'use Tree::DAG_Node::XPath; require Tree::Transform::XSLTish'; +plan skip_all => 'Tree::DAG_Node::XPath and Tree::Transform::XSLTish needed for this test' if $@; +} package Copy;{ use Tree::Transform::XSLTish; @@ -24,12 +30,13 @@ tree_rule match => '*', priority => 0, action => sub { } package main; -use Test::Most 'no_plan','die'; use strict; use warnings; use Tree::Template::Declare options => {builder => Tree::Template::Declare::DAG_Node->new('Tree::DAG_Node::XPath') }; use Data::Dumper; +plan tests=>1; + sub Tree::DAG_Node::XPath::Root::xpath_get_root_node { return $_[0] } sub Tree::DAG_Node::XPath::Root::xpath_get_parent_node { return } diff --git a/t/03-html.t b/t/03-html.t index 2640a5e..8504c90 100644 --- a/t/03-html.t +++ b/t/03-html.t @@ -25,4 +25,7 @@ my $tree=tree { }; }; -diag $tree->as_HTML(); +is($tree->as_HTML(), + qq{Page title

Page para\n}, + 'HTML tree' +); diff --git a/t/04-xml.t b/t/04-xml.t index 606e06d..5281e46 100644 --- a/t/04-xml.t +++ b/t/04-xml.t @@ -5,22 +5,43 @@ use warnings; use Tree::Template::Declare options => {builder => '+LibXML'}; use Data::Dumper; -my $tree=tree { - node { - name 'stuff'; +xmlns test => 'http://test/'; + +sub make_tree { + tree { node { - name 'elem1'; - attribs id => 1; + name 'stuff'; node { - name 'sub1'; - } - }; - node { - name 'elem2'; - attribs id => 2; + name 'test:elem1'; + attribs id => 1, 'test:buh' => 'testing'; + node { + name 'test:sub1'; + } + }; + node { + name 'elem2'; + attribs id => 2; + }; }; }; -}; +} + +{ +my $tree=make_tree(); + +is($tree->serialize(0), + qq{\n\n}, + 'XML document without default NS' +); +} + +xmlns ':default' => 'ftp://test/'; -diag $tree->serialize(); +{ +my $tree=make_tree(); +is($tree->serialize(0), + qq{\n\n}, + 'XML document with default NS' +); +} -- cgit v1.2.3