diff options
author | Gianni Ceccarelli <dakkar@dechirico.(none)> | 2009-03-19 14:41:30 +0100 |
---|---|---|
committer | Gianni Ceccarelli <dakkar@dechirico.(none)> | 2009-03-19 14:41:30 +0100 |
commit | 9c5e82a80749e8ade58bab3efc599d0cd0b99948 (patch) | |
tree | d4372c23b839984edfee86e49cedbe2a06b5491b /lib/Tree/Transform/XSLTish.pm | |
parent | test coverage! (diff) | |
download | Tree-Transform-XSLTish-9c5e82a80749e8ade58bab3efc599d0cd0b99948.tar.gz Tree-Transform-XSLTish-9c5e82a80749e8ade58bab3efc599d0cd0b99948.tar.bz2 Tree-Transform-XSLTish-9c5e82a80749e8ade58bab3efc599d0cd0b99948.zip |
the great renaming, part 1
Diffstat (limited to 'lib/Tree/Transform/XSLTish.pm')
-rw-r--r-- | lib/Tree/Transform/XSLTish.pm | 77 |
1 files changed, 77 insertions, 0 deletions
diff --git a/lib/Tree/Transform/XSLTish.pm b/lib/Tree/Transform/XSLTish.pm new file mode 100644 index 0000000..bf3d18b --- /dev/null +++ b/lib/Tree/Transform/XSLTish.pm @@ -0,0 +1,77 @@ +package Tree::Transform; +use strict; +use warnings; +use Sub::Exporter; +use Params::Validate ':all'; +use Tree::Transform::Utils; +use Tree::Transform::Transformer; +use Carp::Clan qw(^Tree::Transform); + +our $VERSION='0.1'; + +Sub::Exporter::setup_exporter({ + exports => [qw(tree_rule default_rules new_transformer)], + groups => { + default => [ 'tree_rule', + 'default_rules', + 'new_transformer' => {-as => 'new'} ], + } +}); + +sub default_rules { + my $store=Tree::Transform::Utils::_rules_store(scalar caller); + + push @{$store->{by_match}}, + {match=> '/',priority=>0,action=>sub { $_[0]->apply_rules } }, + {match=> '*',priority=>0,action=>sub { $_[0]->apply_rules } }, + ; + return; +} + +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 + # TODO default priority mased on match + + my $store=Tree::Transform::Utils::_rules_store(scalar caller); + + if ($args{match}) { + push @{$store->{by_match}},\%args; + } + if ($args{name}) { + if (exists $store->{by_name}{$args{name}}) { + carp "Duplicate rule named $args{name}, ignoring"; + return; + } + $store->{by_name}{$args{name}}=\%args; + } + + return; +} + +sub _transformer_class { 'Tree::Transform::Transformer' }; + +sub new_transformer { + my ($rules_package)=@_; + + return _transformer_class->new(rules_package=>$rules_package); +} + +1; +__END__ + +=head1 NAME + +Tree::Transform - transform tree data, like XSLT but in Perl + +=head1 AUTHOR + +Gianni Ceccarelli <dakkar@thenautilus.net> + +=cut |