inheritance

3 files changed, 76 insertions, 7 deletions

diff --git a/lib/Tree/Transform/Transformer.pm b/lib/Tree/Transform/Transformer.pm
index 24e5428..685e99e 100644
--- a/lib/Tree/Transform/Transformer.pm
+++ b/lib/Tree/Transform/Transformer.pm
@@ -56,7 +56,7 @@ sub apply_rules {
         #warn "# applying rules to @{[ $node ]}";
 
         my $rule=$self->find_rule();
-        push @ret,$rule->($self);
+        push @ret,$rule->{action}->($self);
     }
 
     $self->leave;
@@ -67,11 +67,21 @@ sub apply_rules {
 sub find_rule {
     my ($self,$context)=@_;
 
-    $context||=$self->context;
+    my $ret=$self->find_rule_in_package($self->rules_package,$context);
+
+    if (!$ret) {
+        croak "No valid rule";
+    }
+
+    return $ret;
+}
+
+sub find_rule_in_package {
+    my ($self,$package,$context)=@_;
 
-    my $store=Tree::Transform::Utils::_rules_store($self->rules_package);
+    $context||=$self->context;
 
-    # TODO inheritance
+    my $store=Tree::Transform::Utils::_rules_store($package);
 
     my $rules=$store->{by_match};
 
@@ -83,11 +93,15 @@ sub find_rule {
                 $candidates[1]->{priority}) {
         croak "Ambiguous rule application";
     }
-    elsif (@candidates == 0) {
-        croak "No valid rule";
+    elsif (@candidates >= 1) {
+        return $candidates[0];
     }
 
-    return $candidates[0]->{action};
+    my @inherited=Tree::Transform::Utils::_get_isa($package);
+    for my $inh_pack (@inherited) {
+        my $ret=$self->find_rule_in_package($inh_pack);
+        return $ret if $ret;
+    }
 }
 
 sub rule_matches {
diff --git a/lib/Tree/Transform/Utils.pm b/lib/Tree/Transform/Utils.pm
index d8786dd..f2b2d6b 100644
--- a/lib/Tree/Transform/Utils.pm
+++ b/lib/Tree/Transform/Utils.pm
@@ -10,4 +10,12 @@ sub _rules_store {
     return *{$_[0].'::_tree_transform_rules'}{HASH};
 }
 
+sub _get_isa {
+    no strict 'refs';
+    if (!defined *{$_[0].'::ISA'}{ARRAY}) {
+        return ();
+    }
+    return @{*{$_[0].'::ISA'}{ARRAY}};
+}
+
 1;
diff --git a/t/02-inherit.t b/t/02-inherit.t
new file mode 100644
index 0000000..3b0f65a
--- /dev/null
+++ b/t/02-inherit.t
@@ -0,0 +1,47 @@
+#!perl
+package TransformA;{
+ use Tree::Transform;
+ use strict;
+ use warnings;
+
+ default_rules;
+
+ tree_rule match => '*', action => sub {
+     return $_[0]->it->name, $_[0]->apply_rules;
+ }
+
+}
+
+package TransformB;{
+ use base 'TransformA';
+ use Tree::Transform;
+ use strict;
+ use warnings;
+
+ tree_rule match => 'coso1', action => sub {
+     return 'sub-coso1';
+ };
+
+ tree_rule match => 'base/coso2', action => sub {
+     return 'sub-coso2';
+ }
+
+}
+
+package main;
+use Test::Most qw(no_plan die);
+use strict;
+use warnings;
+use Tree::DAG_Node::XPath;
+
+sub Tree::DAG_Node::XPath::Root::xpath_get_root_node { return $_[0] }
+
+my $tree=Tree::DAG_Node::XPath->new();
+$tree->name('base');
+$tree->new_daughter->name("coso$_") for 1..5;
+
+{
+my $trans=TransformB->new();
+my @results=$trans->transform($tree);
+is_deeply \@results,[qw(base sub-coso1 sub-coso2 coso3 coso4 coso5)];
+}