From: Dave Rolsky <autarch@urth.org>
Date: Wed, 3 Sep 2008 16:57:13 +0000 (+0000)
Subject: Actually track exactly what coderefs we export by stringified name,
X-Git-Tag: 0.57~3
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=7e3794f4ccd9d9d494423d4f54a0432f8a465cdb;p=gitmo%2FMoose.git

Actually track exactly what coderefs we export by stringified name,
and then in unimport only clean if that stringified name
matches. Previously, we relied on Sub::Name actually being present,
which is not guaranteed.
---

diff --git a/lib/Moose/Exporter.pm b/lib/Moose/Exporter.pm
index fe3bc4a..b09de9e 100644
--- a/lib/Moose/Exporter.pm
+++ b/lib/Moose/Exporter.pm
@@ -33,8 +33,10 @@ sub build_import_methods {
 
     my @exports_from = $class->_follow_also( $exporting_package );
 
-    my $exports
-        = $class->_make_sub_exporter_params( $exporting_package, @exports_from );
+    my $export_recorder = {};
+
+    my $exports = $class->_make_sub_exporter_params(
+        [ $exporting_package, @exports_from ], $export_recorder );
 
     my $exporter = Sub::Exporter::build_exporter(
         {
@@ -49,9 +51,8 @@ sub build_import_methods {
     my $import = $class->_make_import_sub( $exporting_package, $exporter,
         \@exports_from, $args{_export_to_main} );
 
-    my $unimport
-        = $class->_make_unimport_sub( $exporting_package, \@exports_from,
-        [ keys %{$exports} ] );
+    my $unimport = $class->_make_unimport_sub( $exporting_package, $exports,
+        $export_recorder );
 
     return ( $import, $unimport )
 }
@@ -93,12 +94,13 @@ sub build_import_methods {
 }
 
 sub _make_sub_exporter_params {
-    my $class    = shift;
-    my @packages = @_;
+    my $class             = shift;
+    my $packages          = shift;
+    my $export_recorder   = shift;
 
     my %exports;
 
-    for my $package (@packages) {
+    for my $package ( @{$packages} ) {
         my $args = $EXPORT_SPEC{$package}
             or die "The $package package does not use Moose::Exporter\n";
 
@@ -108,10 +110,12 @@ sub _make_sub_exporter_params {
                 \&{ $package . '::' . $name };
             };
 
+            my $fq_name = $package . '::' . $name;
+
             $exports{$name} = $class->_make_wrapped_sub(
-                $package,
-                $name,
-                $sub
+                $fq_name,
+                $sub,
+                $export_recorder,
             );
         }
 
@@ -129,6 +133,8 @@ sub _make_sub_exporter_params {
                 };
             }
 
+            $export_recorder->{$sub} = 1;
+
             $exports{$name} = sub {$sub};
         }
     }
@@ -149,10 +155,11 @@ sub _make_sub_exporter_params {
     my $CALLER;
 
     sub _make_wrapped_sub {
-        my $class             = shift;
-        my $exporting_package = shift;
-        my $name              = shift;
-        my $sub               = shift;
+        shift;
+        my $fq_name         = shift;
+        my $sub             = shift;
+        my $export_recorder = shift;
+
 
         # We need to set the package at import time, so that when
         # package Foo imports has(), we capture "Foo" as the
@@ -162,8 +169,12 @@ sub _make_sub_exporter_params {
         # idea ;)
         return sub {
             my $caller = $CALLER;
-            Class::MOP::subname( $exporting_package . '::'
-                    . $name => sub { $sub->( $caller, @_ ) } );
+
+            my $sub = Class::MOP::subname( $fq_name => sub { $sub->( $caller, @_ ) } );
+
+            $export_recorder->{$sub} = 1;
+
+            return $sub;
         };
     }
 
@@ -282,39 +293,34 @@ sub _get_caller {
 sub _make_unimport_sub {
     shift;
     my $exporting_package = shift;
-    my $sources           = shift;
-    my $keywords          = shift;
+    my $exports           = shift;
+    my $export_recorder   = shift;
 
     return sub {
         my $caller = scalar caller();
         Moose::Exporter->_remove_keywords(
             $caller,
-            [ $exporting_package, @{$sources} ],
-            $keywords
+            [ keys %{$exports} ],
+            $export_recorder,
         );
     };
 }
 
 sub _remove_keywords {
     shift;
-    my $package  = shift;
-    my $sources  = shift;
-    my $keywords = shift;
-
-    my %sources = map { $_ => 1 } @{$sources};
+    my $package          = shift;
+    my $keywords         = shift;
+    my $recorded_exports = shift;
 
     no strict 'refs';
 
-    # loop through the keywords ...
-    foreach my $name ( @{$keywords} ) {
+    foreach my $name ( @{ $keywords } ) {
 
-        # if we find one ...
         if ( defined &{ $package . '::' . $name } ) {
-            my $keyword = \&{ $package . '::' . $name };
+            my $sub = \&{ $package . '::' . $name };
 
             # make sure it is from us
-            my ($pkg_name) = Class::MOP::get_code_info($keyword);
-            next unless $sources{$pkg_name};
+            next unless $recorded_exports->{$sub};
 
             # and if it is from us, then undef the slot
             delete ${ $package . '::' }{$name};