From 1af28933a9cff0015d271306f510e616583431c9 Mon Sep 17 00:00:00 2001
From: Gianni Ceccarelli <dakkar@dechirico.(none)>
Date: Thu, 19 Mar 2009 12:18:17 +0100
Subject: using Class::MOP instead of symbol table hackery

---
 lib/Tree/Transform/Transformer.pm | 32 ++++++++++----------------------
 lib/Tree/Transform/Utils.pm       | 20 ++++++++++----------
 2 files changed, 20 insertions(+), 32 deletions(-)

diff --git a/lib/Tree/Transform/Transformer.pm b/lib/Tree/Transform/Transformer.pm
index c188b29..a773f29 100644
--- a/lib/Tree/Transform/Transformer.pm
+++ b/lib/Tree/Transform/Transformer.pm
@@ -84,25 +84,25 @@ sub call_rule {
 sub find_rule {
     my ($self,$context)=@_;
 
-    my $ret=$self->find_rule_in_package($self->rules_package,$context);
-
-    if (!$ret) {
-        croak "No valid rule";
+    for my $pack (Tree::Transform::Utils::_get_inheritance
+          ($self->rules_package)) {
+        my $ret=$self->find_rule_in_package($pack,$context);
+        return $ret if $ret;
     }
 
-    return $ret;
+    croak "No valid rule";
 }
 
 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";
+    for my $pack (Tree::Transform::Utils::_get_inheritance
+          ($self->rules_package)) {
+        my $ret=$self->find_rule_by_name_in_package($pack,$name,$context);
+        return $ret if $ret;
     }
 
-    return $ret;
+    croak "No rule named $name";
 }
 
 sub find_rule_in_package {
@@ -125,12 +125,6 @@ sub find_rule_in_package {
     elsif (@candidates >= 1) {
         return $candidates[0];
     }
-
-    my @inherited=Tree::Transform::Utils::_get_isa($package);
-    for my $inh_pack (@inherited) {
-        my $ret=$self->find_rule_in_package($inh_pack,$context);
-        return $ret if $ret;
-    }
 }
 
 sub find_rule_by_name_in_package {
@@ -145,12 +139,6 @@ sub find_rule_by_name_in_package {
     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;
-    }
 }
 
 sub rule_matches {
diff --git a/lib/Tree/Transform/Utils.pm b/lib/Tree/Transform/Utils.pm
index f2b2d6b..cdc58f7 100644
--- a/lib/Tree/Transform/Utils.pm
+++ b/lib/Tree/Transform/Utils.pm
@@ -1,21 +1,21 @@
 package Tree::Transform::Utils;
 use strict;
 use warnings;
+use Class::MOP;
+
+my $RULES_NAME='%_tree_transform_rules';
 
 sub _rules_store {
-    no strict 'refs';
-    if (!defined *{$_[0].'::_tree_transform_rules'}{HASH}) {
-        *{$_[0].'::_tree_transform_rules'}={};
+    my $pack=Class::MOP::Class->initialize($_[0]);
+
+    if (! $pack->has_package_symbol($RULES_NAME) ) { 
+        $pack->add_package_symbol($RULES_NAME,{});
     }
-    return *{$_[0].'::_tree_transform_rules'}{HASH};
+    return $pack->get_package_symbol($RULES_NAME);
 }
 
-sub _get_isa {
-    no strict 'refs';
-    if (!defined *{$_[0].'::ISA'}{ARRAY}) {
-        return ();
-    }
-    return @{*{$_[0].'::ISA'}{ARRAY}};
+sub _get_inheritance {
+    return Class::MOP::Class->initialize($_[0])->class_precedence_list;
 }
 
 1;
-- 
cgit v1.2.3