From: Matt S Trout <mst@shadowcat.co.uk>
Date: Sun, 29 Apr 2007 00:36:31 +0000 (+0000)
Subject: * Moose
X-Git-Tag: 0_21~12
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=52c7c33051150fe0851c98369b6c4cb25a1779c1;p=gitmo%2FMoose.git

* Moose
  - added SUPER_SLOT and INNER_SLOT class hashes to support unimport
  - modified unimport to remove super and inner along with the rest
    - altered unimport tests to handle this

* Moose::Role
  - altered super export to populate SUPER_SLOT

* Moose::Meta::Class
  - altered augment and override modifier application to use *_SLOT
    - modified tests for these to unimport one test class each to test
---

diff --git a/Changes b/Changes
index ecd9f7e..04d448b 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,18 @@
 Revision history for Perl extension Moose
 
+0.22
+    * Moose
+      - added SUPER_SLOT and INNER_SLOT class hashes to support unimport
+      - modified unimport to remove super and inner along with the rest
+        - altered unimport tests to handle this
+
+    * Moose::Role
+      - altered super export to populate SUPER_SLOT
+
+    * Moose::Meta::Class
+      - altered augment and override modifier application to use *_SLOT
+        - modified tests for these to unimport one test class each to test
+
 0.21
     * Moose::Meta::Role
       - fixed issue where custom attribute metaclasses
diff --git a/lib/Moose.pm b/lib/Moose.pm
index 5f741fa..9b8c5eb 100644
--- a/lib/Moose.pm
+++ b/lib/Moose.pm
@@ -122,6 +122,11 @@ use Moose::Util::TypeConstraints;
             };
         },
         super => sub {
+            {
+              our %SUPER_SLOT;
+              no strict 'refs';
+              $SUPER_SLOT{$CALLER} = \*{"${CALLER}::super"};
+            }
             return subname 'Moose::super' => sub {};
         },
         override => sub {
@@ -132,6 +137,11 @@ use Moose::Util::TypeConstraints;
             };
         },
         inner => sub {
+            {
+              our %INNER_SLOT;
+              no strict 'refs';
+              $INNER_SLOT{$CALLER} = \*{"${CALLER}::inner"};
+            }
             return subname 'Moose::inner' => sub {};
         },
         augment => sub {
@@ -201,7 +211,6 @@ use Moose::Util::TypeConstraints;
         my $class = caller();
         # loop through the exports ...
         foreach my $name (keys %exports) {
-            next if $name =~ /inner|super|self/;
             
             # if we find one ...
             if (defined &{$class . '::' . $name}) {
diff --git a/lib/Moose/Meta/Class.pm b/lib/Moose/Meta/Class.pm
index 66a2110..cf577c4 100644
--- a/lib/Moose/Meta/Class.pm
+++ b/lib/Moose/Meta/Class.pm
@@ -169,10 +169,14 @@ sub add_override_method_modifier {
         || confess "You cannot override '$name' because it has no super method";    
     $self->add_method($name => Moose::Meta::Method::Overriden->wrap(sub {
         my @args = @_;
-        no strict   'refs';
         no warnings 'redefine';
-        local *{$_super_package . '::super'} = sub { $super->(@args) };
-        return $method->(@args);
+        if ($Moose::SUPER_SLOT{$_super_package}) {
+          local *{$Moose::SUPER_SLOT{$_super_package}}
+            = sub { $super->(@args) };
+          return $method->(@args);
+        } else {
+          confess "Trying to call override modifier'd method without super()";
+        }
     }));
 }
 
@@ -196,10 +200,14 @@ sub add_augment_method_modifier {
     }      
     $self->add_method($name => sub {
         my @args = @_;
-        no strict   'refs';
         no warnings 'redefine';
-        local *{$_super_package . '::inner'} = sub { $method->(@args) };
-        return $super->(@args);
+        if ($Moose::INNER_SLOT{$_super_package}) {
+          local *{$Moose::INNER_SLOT{$_super_package}}
+            = sub { $method->(@args) };
+          return $super->(@args);
+        } else {
+          return $super->(@args);
+        }
     });    
 }
 
diff --git a/lib/Moose/Role.pm b/lib/Moose/Role.pm
index 19c66b0..49810c5 100644
--- a/lib/Moose/Role.pm
+++ b/lib/Moose/Role.pm
@@ -117,6 +117,10 @@ use Moose::Util::TypeConstraints;
 	        };
 	    },
 	    super => sub {
+            {
+              no strict 'refs';
+              $Moose::SUPER_SLOT{$CALLER} = \*{"${CALLER}::super"};
+            }
             my $meta = _find_meta();
             return subname 'Moose::Role::super' => sub {};
         },
diff --git a/t/012_super_and_override.t b/t/012_super_and_override.t
index 04db5de..e04eea5 100644
--- a/t/012_super_and_override.t
+++ b/t/012_super_and_override.t
@@ -32,6 +32,8 @@ BEGIN {
     
     override bar => sub { 'Baz::bar -> ' . super() };       
     override baz => sub { 'Baz::baz -> ' . super() }; 
+
+    no Moose; # ensure super() still works after unimport
 }
 
 my $baz = Baz->new();
diff --git a/t/013_inner_and_augment.t b/t/013_inner_and_augment.t
index 76559df..f129ef2 100644
--- a/t/013_inner_and_augment.t
+++ b/t/013_inner_and_augment.t
@@ -25,6 +25,8 @@ BEGIN {
     
     augment foo => sub { 'Bar::foo(' . (inner() || '') . ')' };   
     augment bar => sub { 'Bar::bar' };       
+
+    no Moose; # ensure inner() still works after unimport
     
     package Baz;
     use Moose;
diff --git a/t/018_import_unimport.t b/t/018_import_unimport.t
index d49d82c..7ada8ad 100644
--- a/t/018_import_unimport.t
+++ b/t/018_import_unimport.t
@@ -15,9 +15,6 @@ my @moose_exports = qw(
     before after around
     override
     augment
-);
-
-my @moose_not_unimported = qw(
     super inner
 );
 
@@ -32,7 +29,6 @@ eval q{
 ok(!$@, '... Moose succesfully exported into Foo');
 
 can_ok('Foo', $_) for @moose_exports;
-can_ok('Foo', $_) for @moose_not_unimported;
 
 eval q{
     package Foo;
@@ -41,7 +37,6 @@ eval q{
 ok(!$@, '... Moose succesfully un-exported from Foo');
 
 ok(!Foo->can($_), '... Foo can no longer do ' . $_) for @moose_exports;
-can_ok('Foo', $_) for @moose_not_unimported;
 
 # and check the type constraints as well