summaryrefslogtreecommitdiff
path: root/lib/Tree/Transform/Transformer.pm
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Tree/Transform/Transformer.pm')
-rw-r--r--lib/Tree/Transform/Transformer.pm51
1 files changed, 50 insertions, 1 deletions
diff --git a/lib/Tree/Transform/Transformer.pm b/lib/Tree/Transform/Transformer.pm
index 685e99e..c188b29 100644
--- a/lib/Tree/Transform/Transformer.pm
+++ b/lib/Tree/Transform/Transformer.pm
@@ -64,6 +64,23 @@ sub apply_rules {
return @ret;
}
+sub call_rule {
+ my ($self,$name)=@_;
+
+ unless ($name) {
+ carp 'call_rule called without a rule name!';
+ return;
+ }
+
+ unless ($self->has_context) {
+ carp 'call_rule called without context!';
+ return;
+ }
+
+ my $rule=$self->find_rule_by_name($name);
+ return $rule->{action}->($self);
+}
+
sub find_rule {
my ($self,$context)=@_;
@@ -76,6 +93,18 @@ sub find_rule {
return $ret;
}
+sub find_rule_by_name {
+ my ($self,$name,$context)=@_;
+
+ my $ret=$self->find_rule_by_name_in_package($self->rules_package,$name,$context);
+
+ if (!$ret) {
+ croak "No rule named $name";
+ }
+
+ return $ret;
+}
+
sub find_rule_in_package {
my ($self,$package,$context)=@_;
@@ -99,7 +128,27 @@ sub find_rule_in_package {
my @inherited=Tree::Transform::Utils::_get_isa($package);
for my $inh_pack (@inherited) {
- my $ret=$self->find_rule_in_package($inh_pack);
+ my $ret=$self->find_rule_in_package($inh_pack,$context);
+ return $ret if $ret;
+ }
+}
+
+sub find_rule_by_name_in_package {
+ my ($self,$package,$name,$context)=@_;
+
+ $context||=$self->context;
+
+ my $store=Tree::Transform::Utils::_rules_store($package);
+
+ my $rules=$store->{by_name};
+
+ if (exists $rules->{$name}) {
+ return $rules->{$name};
+ }
+
+ my @inherited=Tree::Transform::Utils::_get_isa($package);
+ for my $inh_pack (@inherited) {
+ my $ret=$self->find_rule_by_name_in_package($inh_pack,$name,$context);
return $ret if $ret;
}
}