diff options
Diffstat (limited to 'lib/Tree/Template/Declare')
-rw-r--r-- | lib/Tree/Template/Declare/DAG_Node.pm | 91 | ||||
-rw-r--r-- | lib/Tree/Template/Declare/HTML_Element.pm | 111 | ||||
-rw-r--r-- | lib/Tree/Template/Declare/LibXML.pm | 150 |
3 files changed, 352 insertions, 0 deletions
diff --git a/lib/Tree/Template/Declare/DAG_Node.pm b/lib/Tree/Template/Declare/DAG_Node.pm new file mode 100644 index 0000000..6c7d700 --- /dev/null +++ b/lib/Tree/Template/Declare/DAG_Node.pm @@ -0,0 +1,91 @@ +package Tree::Template::Declare::DAG_Node; +use strict; +use warnings; +use Carp; + +our $VERSION='0.6'; + +sub new { + my ($class,$node_class)=@_; + $node_class||='Tree::DAG_Node'; + + eval "require $node_class" or ## no critic (ProhibitStringyEval) + croak "Can't load $node_class: $@"; ## no critic (ProhibitPunctuationVars) + + return bless {nc=>$node_class},$class; +} + +sub new_tree { + my ($self)=@_; + + return bless [],'Tree::Template::Declare::DAG_Node::Tree'; +} + +sub finalize_tree { + my ($self,$tree)=@_; + + return $tree->[0]; +} + +sub new_node { + my ($self)=@_; + + return $self->{nc}->new(); +} + +sub add_child_node { + my ($self,$parent,$child)=@_; + + if ($parent->isa('Tree::Template::Declare::DAG_Node::Tree')) { + push @{$parent},$child; + return $parent; + } + return $parent->add_daughter($child); +} + +sub set_node_name { + my ($self,$node,$name)=@_; + + return $node->name($name); +} + +sub set_node_attributes { + my ($self,$node,$attrs)=@_; + + my %all_attributes=( + %{$node->attributes}, + %{$attrs}, + ); + + return $node->attributes(\%all_attributes); +} + +1; +__END__ + +=head1 NAME + +Tree::Template::Declare::DAG_Node + +=head1 SYNOPSIS + +See L<Tree::Template::Declare>. + +=head1 SPECIFICITIES + +This module will build trees using L<Tree::DAG_Node>. You can make it +use another module (assuming it has the same interface, for example +L<Tree::DAG_Node::XPath>) by passing the class name to the C<new> +method. + + use Tree::Template::Declare builder => '+DAG_Node'; # default + + use Tree::Template::Declare builder => + Tree::Template::Declare::DAG_Node->new('Tree::DAG_Node::XPath'); + # custom class + +=head1 AUTHOR + +Gianni Ceccarelli <dakkar@thenautilus.net> + +=cut diff --git a/lib/Tree/Template/Declare/HTML_Element.pm b/lib/Tree/Template/Declare/HTML_Element.pm new file mode 100644 index 0000000..f8bdb90 --- /dev/null +++ b/lib/Tree/Template/Declare/HTML_Element.pm @@ -0,0 +1,111 @@ +package Tree::Template::Declare::HTML_Element; +use strict; +use warnings; +use Carp; +use HTML::Element; + +our $VERSION='0.6'; + +sub new { + my ($class)=@_; + + return bless {},$class; +} + +sub _munge_exports { + my ($self,$exports)=@_; + + my %all_exports=( + %{$exports}, + text_node => sub($) { + $exports->{node}->( + sub { + $exports->{name}->('~text'); + $exports->{attribs}->(text => $_[0]); + }); + }, + ); + + return \%all_exports; +} + +sub new_tree { + my ($self)=@_; + + return bless [],'Tree::Template::Declare::HTML_Element::Tree'; +} + +sub finalize_tree { + my ($self,$tree)=@_; + + my $dom=$tree->[0]; + $dom->deobjectify_text(); + return $dom; +} + +sub new_node { + my ($self)=@_; + + return HTML::Element->new('~comment'); +} + +sub add_child_node { + my ($self,$parent,$child)=@_; + + + if ($parent->isa('Tree::Template::Declare::HTML_Element::Tree')) { + push @{$parent},$child; + return $parent; + } + return $parent->push_content($child); +} + +sub set_node_name { + my ($self,$node,$name)=@_; + + return $node->tag($name); +} + +sub set_node_attributes { + my ($self,$node,$attrs)=@_; + + while (my ($name,$val)=each %{$attrs}) { + $node->attr($name, $val); + } + return; +} + +1; +__END__ + +=head1 NAME + +Tree::Template::Declare::HTML_Element + +=head1 SYNOPSIS + +See L<Tree::Template::Declare>. + +=head1 SPECIFICITIES + +This module will build trees using L<HTML::Element>. + +To create text nodes, you would be forced to say: + + node { + name '~text'; + attribs text => 'some text'; + } + +which is too cumbersone. You can instead use: + + text_node 'some text'; + +HTML::Element's C<deobjectify_text> method will be called by +C<finalize_tree> before returning the tree object. + +=head1 AUTHOR + +Gianni Ceccarelli <dakkar@thenautilus.net> + +=cut diff --git a/lib/Tree/Template/Declare/LibXML.pm b/lib/Tree/Template/Declare/LibXML.pm new file mode 100644 index 0000000..246ab8d --- /dev/null +++ b/lib/Tree/Template/Declare/LibXML.pm @@ -0,0 +1,150 @@ +package Tree::Template::Declare::LibXML; +use strict; +use warnings; +use Carp; +use XML::LibXML; + +our $VERSION='0.6'; + +sub new { + my ($class)=@_; + + return bless {ns=>{':default'=>undef}},$class; +} + +sub _munge_exports { + my ($self,$exports,$current_node_aref)=@_; + + my %all_exports=( + %{$exports}, + xmlns => sub($$) { + $self->{ns}->{$_[0]}=$_[1]; + return; + }, + text_node => sub($) { + if ($current_node_aref->[0]) { + $current_node_aref->[0]->appendTextNode($_[0]); + } + }, + ); + + return \%all_exports; +} + +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) || 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; + if ($doc) { + $child=$doc->adoptNode($child); + } + + 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); + } + + return; +} + +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. + +To add text nodes, you could do something like: + + my $el=node { name 'elem_with_text' }; + $el->appendTextNode('some text content'); + +This is ugly, so you can do: + + node { + name 'elem_with_text'; + text_node 'some text content'; + }; + +=head1 AUTHOR + +Gianni Ceccarelli <dakkar@thenautilus.net> + +=cut |