From bd5e373db0ee7b496fe1827a767567f2f26064a8 Mon Sep 17 00:00:00 2001
From: Gianni Ceccarelli <dakkar@dechirico.(none)>
Date: Fri, 20 Mar 2009 15:54:44 +0100
Subject: skip compatibility tests if required modules are not present added
 LibXML test

---
 Makefile.PL                               |  2 --
 lib/Tree/Transform/XSLTish.pm             | 33 +++++++++++++++++++++++++++
 lib/Tree/Transform/XSLTish/Transformer.pm | 14 +++++++++---
 t/05-html-tree.t                          |  6 +++--
 t/06-libxml.t                             | 37 +++++++++++++++++++++++++++++++
 5 files changed, 85 insertions(+), 7 deletions(-)
 create mode 100644 t/06-libxml.t

diff --git a/Makefile.PL b/Makefile.PL
index bd808dd..11e7649 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -12,8 +12,6 @@ requires 'Tree::XPathEngine' => 0,
 
 test_requires 'Test::Most'   => 0,
               'Tree::DAG_Node::XPath' => 0,
-              'HTML::TreeBuilder::XPath' => 0,
-              'XML::XPathEngine' => 0,
 ;
 
 WriteAll;
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;
         }
 
diff --git a/t/05-html-tree.t b/t/05-html-tree.t
index a562aba..c025251 100644
--- a/t/05-html-tree.t
+++ b/t/05-html-tree.t
@@ -13,10 +13,12 @@ package HtmlTransform;{
 }
 
 package main;
-use Test::Most qw(no_plan die);
+use Test::Most 'die';
 use strict;
 use warnings;
-use HTML::TreeBuilder::XPath;
+eval 'use XML::XPathEngine;use HTML::TreeBuilder::XPath;';
+plan skip_all => 'XML::XPathEngine and HTML::TreeBuilder::XPath needed for this test' if $@;
+plan tests=> 1;
 
 sub HTML::TreeBuilder::XPath::Root::getRootNode { return $_[0] }
 
diff --git a/t/06-libxml.t b/t/06-libxml.t
new file mode 100644
index 0000000..2377738
--- /dev/null
+++ b/t/06-libxml.t
@@ -0,0 +1,37 @@
+#!perl
+package XmlTransform;{
+ 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 Test::Most 'die';
+use strict;
+use warnings;
+eval 'use XML::LibXML;use XML::LibXML::XPathContext;';
+plan skip_all => 'XML::LibXML and XML::LibXML::XPathContext needed for this test' if $@;
+plan tests=>1;
+
+my $tree=XML::LibXML->new->parse_string(<<'XML');
+<html>
+ <body>
+  <p>test</p>
+  <img src="nothing" />
+  <img src="this one" alt="pick" />
+ </body>
+</html>
+XML
+
+{
+my $trans=XmlTransform->new(engine=>XML::LibXML::XPathContext->new());
+my @results=$trans->transform($tree);
+is_deeply \@results,['this one'],'XML example';
+}
-- 
cgit v1.2.3