diff options
author | Gianni Ceccarelli <dakkar@dechirico.(none)> | 2009-03-17 16:34:32 +0100 |
---|---|---|
committer | Gianni Ceccarelli <dakkar@dechirico.(none)> | 2009-03-17 16:34:32 +0100 |
commit | 8485905de8b4c60dc6cc8672621ef0ae61df48fa (patch) | |
tree | e43681ad96f76280c193d6083cf1be246ecc672f | |
parent | ignores (diff) | |
download | Tree-Transform-XSLTish-8485905de8b4c60dc6cc8672621ef0ae61df48fa.tar.gz Tree-Transform-XSLTish-8485905de8b4c60dc6cc8672621ef0ae61df48fa.tar.bz2 Tree-Transform-XSLTish-8485905de8b4c60dc6cc8672621ef0ae61df48fa.zip |
some functions
-rw-r--r-- | Makefile.PL | 8 | ||||
-rw-r--r-- | lib/Tree/Transform.pm | 44 | ||||
-rw-r--r-- | t/01-basic.t | 30 |
3 files changed, 80 insertions, 2 deletions
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)]; |