From: Dave Rolsky <autarch@urth.org>
Date: Wed, 6 Aug 2008 20:18:05 +0000 (+0000)
Subject: Revert the change to get rid of caller()-currying for Moose.pm
X-Git-Tag: 0_55_01~43^2~23
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=97a9305604a779c40c85acbb993f69cf689d72b0;p=gitmo%2FMoose.git

Revert the change to get rid of caller()-currying for Moose.pm
exports. Sigh.
---

diff --git a/lib/Moose.pm b/lib/Moose.pm
index e67c48b..2edbffe 100644
--- a/lib/Moose.pm
+++ b/lib/Moose.pm
@@ -27,7 +27,7 @@ use Moose::Util::TypeConstraints;
 use Moose::Util ();
 
 sub extends {
-    my $class = caller();
+    my $class = shift;
 
     croak "Must derive at least one class" unless @_;
 
@@ -50,12 +50,12 @@ sub extends {
 }
 
 sub with {
-    my $class = caller();
+    my $class = shift;
     Moose::Util::apply_all_roles($class->meta, @_);
 }
 
 sub has {
-    my $class = caller();
+    my $class = shift;
     my $name  = shift;
     croak 'Usage: has \'name\' => ( key => value, ... )' if @_ == 1;
     my %options = @_;
@@ -64,17 +64,17 @@ sub has {
 }
 
 sub before {
-    my $class = caller();
+    my $class = shift;
     Moose::Util::add_method_modifier($class, 'before', \@_);
 }
 
 sub after {
-    my $class = caller();
+    my $class = shift;
     Moose::Util::add_method_modifier($class, 'after', \@_);
 }
 
 sub around {
-    my $class = caller();
+    my $class = shift;
     Moose::Util::add_method_modifier($class, 'around', \@_);
 }
 
@@ -83,7 +83,7 @@ sub super {
 }
 
 sub override {
-    my $class = caller();
+    my $class = shift;
     my ( $name, $method ) = @_;
     $class->meta->add_override_method_modifier( $name => $method );
 }
@@ -103,21 +103,24 @@ sub inner {
 }
 
 sub augment {
-    my $class = caller();
+    my $class = shift;
     my ( $name, $method ) = @_;
     $class->meta->add_augment_method_modifier( $name => $method );
 }
 
 sub make_immutable {
-    my $class = caller();
+    my $class = shift;
     cluck "The make_immutable keyword has been deprecated, " . 
           "please go back to __PACKAGE__->meta->make_immutable\n";
     $class->meta->make_immutable(@_);
 }
 
 my $exporter = Moose::Exporter->build_import_methods(
-    export => [
-        qw( extends with has before after around override augment make_immutable super inner ),
+    with_caller => [
+        qw( extends with has before after around override augment make_immutable )
+    ],
+    as_is => [
+        qw( super inner ),
         \&Carp::confess,
         \&Scalar::Util::blessed,
     ],
diff --git a/lib/Moose/Exporter.pm b/lib/Moose/Exporter.pm
index 43ed882..800e6df 100644
--- a/lib/Moose/Exporter.pm
+++ b/lib/Moose/Exporter.pm
@@ -24,8 +24,7 @@ sub build_import_methods {
     );
 
     my $import = $class->_make_import_sub(
-        $exporting_package,
-        $args{init_meta_args},
+        $exporting_package, $args{init_meta_args},
         $exporter
     );
 
@@ -45,8 +44,20 @@ sub _build_exporter {
 
     my @exported_names;
     my %exports;
-    for my $name ( @{ $args{export} } ) {
+    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 };
+
+        push @exported_names, $name;
+    }
+
+    for my $name ( @{ $args{as_is} } ) {
         my $sub;
+
         if ( ref $name ) {
             $sub  = $name;
             $name = ( Class::MOP::get_code_info($name) )[1];
@@ -58,8 +69,6 @@ sub _build_exporter {
         }
 
         $exports{$name} = sub { $sub };
-
-        push @exported_names, $name;
     }
 
     my $exporter = Sub::Exporter::build_exporter(
@@ -98,8 +107,8 @@ sub _make_import_sub {
 
         if ( $exporting_package->can('_init_meta') ) {
             $exporting_package->_init_meta(
-                %{ $init_meta_args || {} },
                 for_class => $caller,
+                %{ $init_meta_args || {} }
             );
         }
 
@@ -196,7 +205,14 @@ This method accepts the following parameters:
 
 =over 4
 
-=item * export => [ ... ]
+=item * with_caller => [ ... ]
+
+This a list of function I<names only> to be exported wrapped and then
+exported. The wrapper will pass the name of the calling package as the
+first argument to the function. Many sugar functions need to know
+their caller so they can get the calling package's metaclass object.
+
+=item * as_is => [ ... ]
 
 This a list of function names or sub references to be exported
 as-is. You can identify a subroutine by reference, which is handy to
diff --git a/lib/Moose/Role.pm b/lib/Moose/Role.pm
index 8a7bc4f..93727ef 100644
--- a/lib/Moose/Role.pm
+++ b/lib/Moose/Role.pm
@@ -24,27 +24,23 @@ sub extends {
 }
 
 sub with {
-    my $role = caller();
-    Moose::Util::apply_all_roles( $role->meta(), @_ );
+    Moose::Util::apply_all_roles( shift->meta(), @_ );
 }
 
 sub requires {
-    my $role = caller();
-    my $meta = $role->meta();
+    my $meta = shift->meta();
     croak "Must specify at least one method" unless @_;
     $meta->add_required_methods(@_);
 }
 
 sub excludes {
-    my $role = caller();
-    my $meta = $role->meta();
+    my $meta = shift->meta();
     croak "Must specify at least one role" unless @_;
     $meta->add_excluded_roles(@_);
 }
 
 sub has {
-    my $role = caller();
-    my $meta = $role->meta();
+    my $meta = shift->meta();
     my $name = shift;
     croak 'Usage: has \'name\' => ( key => value, ... )' if @_ == 1;
     my %options = @_;
@@ -53,8 +49,7 @@ sub has {
 }
 
 sub before {
-    my $role = caller();
-    my $meta = $role->meta();
+    my $meta = shift->meta();
     my $code = pop @_;
 
     for (@_) {
@@ -67,8 +62,7 @@ sub before {
 }
 
 sub after {
-    my $role = caller();
-    my $meta = $role->meta();
+    my $meta = shift->meta();
 
     my $code = pop @_;
     for (@_) {
@@ -81,8 +75,7 @@ sub after {
 }
 
 sub around {
-    my $role = caller();
-    my $meta = $role->meta();
+    my $meta = shift->meta();
     my $code = pop @_;
     for (@_) {
         croak "Moose::Role do not currently support "
@@ -100,8 +93,7 @@ sub super {
 }
 
 sub override {
-    my $role = caller();
-    my $meta = $role->meta();
+    my $meta = shift->meta();
     my ( $name, $code ) = @_;
     $meta->add_override_method_modifier( $name, $code );
 }
@@ -115,8 +107,11 @@ sub augment {
 }
 
 my $exporter = Moose::Exporter->build_import_methods(
-    export => [
-        qw( with requires excludes has before after around override extends super inner augment ),
+    with_caller => [
+        qw( with requires excludes has before after around override make_immutable )
+    ],
+    as_is => [
+        qw( extends super inner augment ),
         \&Carp::confess,
         \&Scalar::Util::blessed,
     ],