From 9c5e82a80749e8ade58bab3efc599d0cd0b99948 Mon Sep 17 00:00:00 2001
From: Gianni Ceccarelli <dakkar@dechirico.(none)>
Date: Thu, 19 Mar 2009 14:41:30 +0100
Subject: the great renaming, part 1

---
 lib/Tree/Transform/XSLTish.pm | 77 +++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 77 insertions(+)
 create mode 100644 lib/Tree/Transform/XSLTish.pm

(limited to 'lib/Tree/Transform/XSLTish.pm')

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
-- 
cgit v1.2.3