From: Dave Rolsky <autarch@urth.org>
Date: Wed, 6 Aug 2008 20:26:30 +0000 (+0000)
Subject: Fix caller determination to work the same way as it did in old school
X-Git-Tag: 0_55_01~43^2~22
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=3492a4cd521f7564ae3982a499c9161c3cf94c69;p=gitmo%2FMoose.git

Fix caller determination to work the same way as it did in old school
Moose.pm.
---

diff --git a/lib/Moose/Exporter.pm b/lib/Moose/Exporter.pm
index 800e6df..c4f19a2 100644
--- a/lib/Moose/Exporter.pm
+++ b/lib/Moose/Exporter.pm
@@ -47,10 +47,25 @@ sub _build_exporter {
     for my $name ( @{ $args{with_caller} } ) {
         my $sub = do { no strict 'refs'; \&{ $exporting_package . '::' . $name } };
 
-        my $wrapped = Class::MOP::subname(
-            $exporting_package . '::' . $name => sub { $sub->( scalar caller(), @_ ) } );
-
-        $exports{$name} = sub { $wrapped };
+        # We need to set the package at import time, so that when
+        # package Foo imports has(), we capture "Foo" as the
+        # package. This lets other packages call Foo::has() and get
+        # the right package. This is done for backwards compatibility
+        # with existing production code, not because this is a good
+        # idea ;)
+        $exports{$name} = sub {
+            my $caller;
+
+            my $x = 0;
+            do
+            {
+                $caller = scalar caller($x++)
+            }
+            while ( $caller eq 'Sub::Exporter' );
+
+            Class::MOP::subname( $exporting_package . '::'
+                    . $name => sub { $sub->( $caller, @_ ) } );
+        };
 
         push @exported_names, $name;
     }