From 8485905de8b4c60dc6cc8672621ef0ae61df48fa Mon Sep 17 00:00:00 2001
From: Gianni Ceccarelli <dakkar@dechirico.(none)>
Date: Tue, 17 Mar 2009 16:34:32 +0100
Subject: some functions

---
 Makefile.PL           |  8 ++++++--
 lib/Tree/Transform.pm | 44 ++++++++++++++++++++++++++++++++++++++++++++
 t/01-basic.t          | 30 ++++++++++++++++++++++++++++++
 3 files changed, 80 insertions(+), 2 deletions(-)
 create mode 100644 t/01-basic.t

diff --git a/Makefile.PL b/Makefile.PL
index faec885..c06ad85 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -5,8 +5,12 @@ license  'perl';
 all_from 'lib/Tree/Transform.pm';
 
 requires 'Tree::XPathEngine' => 0,
-         'Moose'             => 0;
+         'Moose'             => 0,
+         'Params::Validate'  => 0,
+;
 
-test_requires 'Test::Most' => 0;
+test_requires 'Test::Most'   => 0,
+              'Tree::DAG_Node::XPath' => 0,
+;
 
 WriteAll;
diff --git a/lib/Tree/Transform.pm b/lib/Tree/Transform.pm
index 99cc07f..7b9af2c 100644
--- a/lib/Tree/Transform.pm
+++ b/lib/Tree/Transform.pm
@@ -1,8 +1,52 @@
 package Tree::Transform;
 use Moose;
+use Sub::Exporter;
+use Params::Validate ':all';
 
 our $VERSION='0.1';
 
+Sub::Exporter::setup_exporter({
+    exports => [qw(tree_rule new_transformer)],
+    groups => {
+        default => [ 'tree_rule',
+                     'new_transformer' => {-as => 'new'} ],
+    }
+});
+
+sub _rules_store {
+    no strict 'refs';
+    if (!defined *{$_[0].'::_tree_transform_rules'}{HASH}) {
+        *{$_[0].'::_tree_transform_rules'}={};
+    }
+    return *{$_[0].'::_tree_transform_rules'}{HASH};
+}
+
+sub tree_rule {
+    my (%args)=validate(@_, {
+        match => { type => SCALAR, optional => 1 },
+        action => { type => CODEREF },
+        name => { type => SCALAR, optional => 1},
+        priority => { type => SCALAR, default => 1 },
+    });
+
+    # TODO at least one of 'name' and 'match' must be specified
+
+    my $store=_rules_store(scalar caller);
+
+    push @{$store->{by_match}},\%args;
+    if ($args{name}) {
+        push @{$store->{by_name}{$args{name}}},\%args;
+    }
+
+    return;
+}
+
+sub new_transformer {
+}
+
+__PACKAGE__->meta->make_immutable;no Moose;
+__END__
+
 =head1 NAME
 
 Tree::Transform - transform tree data, like XSLT but in Perl
diff --git a/t/01-basic.t b/t/01-basic.t
new file mode 100644
index 0000000..e9b285b
--- /dev/null
+++ b/t/01-basic.t
@@ -0,0 +1,30 @@
+#!perl
+package BasicTransform;{
+ use Tree::Transform;
+ use strict;
+ use warnings;
+
+ tree_rule match => '/', action => sub {
+     return 'root', $_[0]->apply_rules;
+ };
+
+ tree_rule match => '*', action => sub {
+     return $_[0]->it->name;
+ }
+
+}
+
+package main;
+use Test::Most qw(no_plan die);
+use strict;
+use warnings;
+use Tree::DAG_Node::XPath;
+
+my $tree=Tree::DAG_Node::XPath->new();
+$tree->new_daughter->name("coso$_") for 1..5;
+
+my $trans=BasicTransform->new();
+
+my @results=$trans->apply_rules($tree);
+
+is_deeply \@results,[qw(root coso1 coso2 coso3 coso4 coso5)];
-- 
cgit v1.2.3