diff options
Diffstat (limited to 'lib')
-rw-r--r-- | lib/Tree/Transform/XSLTish.pm | 33 | ||||
-rw-r--r-- | lib/Tree/Transform/XSLTish/Transformer.pm | 14 |
2 files changed, 44 insertions, 3 deletions
diff --git a/lib/Tree/Transform/XSLTish.pm b/lib/Tree/Transform/XSLTish.pm index 8be326d..c79dae7 100644 --- a/lib/Tree/Transform/XSLTish.pm +++ b/lib/Tree/Transform/XSLTish.pm @@ -89,6 +89,29 @@ Tree::Transform::XSLTish - transform tree data, like XSLT but in Perl my ($node5_data)=MyTransform->new->transform($tree); +Transforming an HTML document: + + package HtmlTransform; + use Tree::Transform::XSLTish; + use strict; + use warnings; + + default_rules; + + tree_rule match => 'img[@alt="pick"]', action => sub { + return $_[0]->it->findvalue('@src'); + }; + + package main; + use XML::XPathEngine; + use HTML::TreeBuilder::XPath; + + my $tree=HTML::TreeBuilder::XPath->new(); + $tree->parse_file('mypage.html'); + + my $trans=HtmlTransform->new(engine=>XML::XPathEngine->new()); + my ($image_srce)=$trans->transform($tree); + =head1 DESCRIPTION This module allows you to transform tree with Perl subroutines, just @@ -98,6 +121,16 @@ It tries to model as closely as reasonable the semantic of XSLT. =head1 REQUIREMENTS +By default, this module uses L<Tree::XPathEngine> as its XPath engine, +but you can use any other similar module, provided it implements the +method C<findnodes> with the same signature and +meaning. L<XML::XPathEngine> is a good candidate. + +The tree that you intend to manipulate must be implemented by classes +that are compatible with the XPath engine; for example, +L<Tree::DAG_Node::XPath> if you use L<Tree::XPathEngine>, or +L<HTML::TreeBuilder::XPath> if you use L<XML::XPathEngine>. + =head1 AUTHOR Gianni Ceccarelli <dakkar@thenautilus.net> diff --git a/lib/Tree/Transform/XSLTish/Transformer.pm b/lib/Tree/Transform/XSLTish/Transformer.pm index 8b06422..c6102a7 100644 --- a/lib/Tree/Transform/XSLTish/Transformer.pm +++ b/lib/Tree/Transform/XSLTish/Transformer.pm @@ -12,7 +12,7 @@ subtype 'Tree::Transform::XSLTish::Engine' => as 'Object' => where { my $object=$_; - for my $meth (qw(findnodes matches exists)) { + for my $meth (qw(findnodes)) { return unless $object->can($meth); } return 1; @@ -164,11 +164,19 @@ sub rule_matches { # XXX check the semantic my $base_node=$node; + + # this is a ugly hack + my $test_sub= ($node->can('isSameNode'))? + sub { grep { $node->isSameNode($_) } @_ } + : + sub { grep { "$node" eq "$_" } @_ }; + while ($base_node) { #warn "# Testing <$path> against @{[ $node ]} based on @{[ $base_node ]}"; - - if ($self->engine->matches($node,$path,$base_node)) { + my @selected_nodes=$self->engine->findnodes($path,$base_node); + #warn "# selected: @selected_nodes\n"; + if ($test_sub->(@selected_nodes)) { return 1; } |