From 1a2822c8b182b19d70fd116a3a0bcf038caa6aef Mon Sep 17 00:00:00 2001
From: Gianni Ceccarelli <dakkar@dechirico.(none)>
Date: Wed, 25 Mar 2009 16:48:14 +0100
Subject: now you can specify the engine in the transfor class

---
 TODO                                      |  5 -----
 lib/Tree/Transform/XSLTish.pm             | 29 +++++++++++++++++++++++++----
 lib/Tree/Transform/XSLTish/Transformer.pm | 15 ++++++++++++++-
 lib/Tree/Transform/XSLTish/Utils.pm       | 12 ++++++++++++
 t/05-html-tree.t                          |  6 ++++--
 t/06-libxml.t                             |  6 ++++--
 6 files changed, 59 insertions(+), 14 deletions(-)

diff --git a/TODO b/TODO
index 7133388..b61c557 100644
--- a/TODO
+++ b/TODO
@@ -1,6 +1 @@
 .. -*- mode: rst; coding: utf-8 -*-
-
-- specify the engine in the transform package, not in the constructor
-
-  * ``engine_class $class_name``
-  * ``engine_factory \&factory``
diff --git a/lib/Tree/Transform/XSLTish.pm b/lib/Tree/Transform/XSLTish.pm
index 3889b3a..97a6f1f 100644
--- a/lib/Tree/Transform/XSLTish.pm
+++ b/lib/Tree/Transform/XSLTish.pm
@@ -9,12 +9,15 @@ use Carp::Clan qw(^Tree::Transform::XSLTish);
 
 our $VERSION='0.1';
 
+my @DEFAULT_EXPORTS=('tree_rule',
+                     'default_rules',
+                     'new_transformer' => {-as => 'new'});
+
 Sub::Exporter::setup_exporter({
-    exports => [qw(tree_rule default_rules new_transformer)],
+    exports => [qw(tree_rule default_rules new_transformer engine_class engine_factory)],
     groups => {
-        default => [ 'tree_rule',
-                     'default_rules',
-                     'new_transformer' => {-as => 'new'} ],
+        default => \@DEFAULT_EXPORTS,
+        engine => [@DEFAULT_EXPORTS, qw(engine_class engine_factory)],
     }
 });
 
@@ -55,6 +58,24 @@ sub tree_rule {
     return;
 }
 
+sub engine_class {
+    my ($classname)=@_;
+
+    my $factory=Tree::Transform::XSLTish::Utils::_engine_factory(scalar caller);
+    $$factory=sub{$classname->new()};
+
+    return;
+}
+
+sub engine_factory {
+    my ($new_factory)=@_;
+
+    my $factory=Tree::Transform::XSLTish::Utils::_engine_factory(scalar caller);
+    $$factory=$new_factory;
+
+    return;
+}
+
 sub _transformer_class { 'Tree::Transform::XSLTish::Transformer' };
 
 sub new_transformer {
diff --git a/lib/Tree/Transform/XSLTish/Transformer.pm b/lib/Tree/Transform/XSLTish/Transformer.pm
index c6102a7..fd61ea6 100644
--- a/lib/Tree/Transform/XSLTish/Transformer.pm
+++ b/lib/Tree/Transform/XSLTish/Transformer.pm
@@ -36,9 +36,22 @@ has 'context_stack' => (
 has 'engine' => (
     is => 'ro',
     isa => 'Tree::Transform::XSLTish::Engine',
-    default => sub { Tree::XPathEngine->new() },
+    lazy => 1,
+    builder => '_build_engine',
 );
 
+sub _build_engine {
+    my ($self)=@_;
+
+    if ($self->rules_package) {
+        my $factory=Tree::Transform::XSLTish::Utils::_engine_factory($self->rules_package);
+        if ($$factory) {
+            return $$factory->();
+        }
+    }
+    return Tree::XPathEngine->new();
+}
+
 sub it { $_[0]->context->current_node }
 
 sub transform {
diff --git a/lib/Tree/Transform/XSLTish/Utils.pm b/lib/Tree/Transform/XSLTish/Utils.pm
index 11a25cb..bed1167 100644
--- a/lib/Tree/Transform/XSLTish/Utils.pm
+++ b/lib/Tree/Transform/XSLTish/Utils.pm
@@ -14,6 +14,18 @@ sub _rules_store {
     return $pack->get_package_symbol($RULES_NAME);
 }
 
+my $ENGINE_FACTORY_NAME='$_tree_transform_engine_factory';
+
+sub _engine_factory {
+    my $pack=Class::MOP::Class->initialize($_[0]);
+
+    if (! $pack->has_package_symbol($ENGINE_FACTORY_NAME) ) { 
+        $pack->add_package_symbol($ENGINE_FACTORY_NAME,undef);
+    }
+    return $pack->get_package_symbol($ENGINE_FACTORY_NAME);
+}
+
+
 sub _get_inheritance {
     return Class::MOP::Class->initialize($_[0])->class_precedence_list;
 }
diff --git a/t/05-html-tree.t b/t/05-html-tree.t
index c025251..eb990e8 100644
--- a/t/05-html-tree.t
+++ b/t/05-html-tree.t
@@ -1,9 +1,11 @@
 #!perl
 package HtmlTransform;{
- use Tree::Transform::XSLTish;
+ use Tree::Transform::XSLTish ':engine';
  use strict;
  use warnings;
 
+ engine_class 'XML::XPathEngine';
+
  default_rules;
 
  tree_rule match => 'img[@alt="pick"]', action => sub {
@@ -34,7 +36,7 @@ $tree->parse(<<'HTML');$tree->eof;
 HTML
 
 {
-my $trans=HtmlTransform->new(engine=>XML::XPathEngine->new());
+my $trans=HtmlTransform->new();
 my @results=$trans->transform($tree);
 is_deeply \@results,['this one'],'HTML example';
 }
diff --git a/t/06-libxml.t b/t/06-libxml.t
index 2377738..f496301 100644
--- a/t/06-libxml.t
+++ b/t/06-libxml.t
@@ -1,9 +1,11 @@
 #!perl
 package XmlTransform;{
- use Tree::Transform::XSLTish;
+ use Tree::Transform::XSLTish ':engine';
  use strict;
  use warnings;
 
+ engine_class 'XML::LibXML::XPathContext';
+
  default_rules;
 
  tree_rule match => 'img[@alt="pick"]', action => sub {
@@ -31,7 +33,7 @@ my $tree=XML::LibXML->new->parse_string(<<'XML');
 XML
 
 {
-my $trans=XmlTransform->new(engine=>XML::LibXML::XPathContext->new());
+my $trans=XmlTransform->new();
 my @results=$trans->transform($tree);
 is_deeply \@results,['this one'],'XML example';
 }
-- 
cgit v1.2.3