X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FExporter.pm;h=8151e6db2cca18e39ac2e1d8ee299ef89408be20;hb=76137842d7010ea2ed733584727c8871ff1d032e;hp=3a35c4c4415f049e2d0410dbef780a54d51d95fe;hpb=9409e92e75a6e1060eb3d0adcfc7965713d3d776;p=gitmo%2FMoose.git

diff --git a/lib/Moose/Exporter.pm b/lib/Moose/Exporter.pm
index 3a35c4c..8151e6d 100644
--- a/lib/Moose/Exporter.pm
+++ b/lib/Moose/Exporter.pm
@@ -3,7 +3,7 @@ package Moose::Exporter;
 use strict;
 use warnings;
 
-our $VERSION   = '0.72';
+our $VERSION   = '0.83';
 $VERSION = eval $VERSION;
 our $AUTHORITY = 'cpan:STEVAN';
 
@@ -11,7 +11,7 @@ use Class::MOP;
 use List::MoreUtils qw( first_index uniq );
 use Moose::Util::MetaRole;
 use Sub::Exporter;
-
+use Sub::Name qw(subname);
 
 my %EXPORT_SPEC;
 
@@ -76,8 +76,13 @@ sub build_import_methods {
     sub _follow_also_real {
         my $exporting_package = shift;
 
-        die "Package in also ($exporting_package) does not seem to use Moose::Exporter"
-            unless exists $EXPORT_SPEC{$exporting_package};
+        if (!exists $EXPORT_SPEC{$exporting_package}) {
+            my $loaded = Class::MOP::is_class_loaded($exporting_package);
+
+            die "Package in also ($exporting_package) does not seem to "
+              . "use Moose::Exporter"
+              . ($loaded ? "" : " (is it loaded?)");
+        }
 
         my $also = $EXPORT_SPEC{$exporting_package}{also};
 
@@ -182,9 +187,9 @@ sub _make_wrapped_sub {
     return sub {
         my $caller = $CALLER;
 
-        my $wrapper = $self->_make_wrapper($caller, $sub, $fq_name);
+        my $wrapper = $self->_curry_wrapper($sub, $fq_name, $caller);
 
-        my $sub = Class::MOP::subname($fq_name => $wrapper);
+        my $sub = subname($fq_name => $wrapper);
 
         $export_recorder->{$sub} = 1;
 
@@ -192,13 +197,19 @@ sub _make_wrapped_sub {
     };
 }
 
-sub _make_wrapper {
-    shift;
-    my $caller  = shift;
+sub _curry_wrapper {
+    my $class   = shift;
     my $sub     = shift;
     my $fq_name = shift;
+    my @extra   = @_;
 
-    return sub { $sub->($caller, @_) };
+    my $wrapper = sub { $sub->(@extra, @_) };
+    if (my $proto = prototype $sub) {
+        # XXX - Perl's prototype sucks. Use & to make set_prototype
+        # ignore the fact that we're passing "private variables"
+        &Scalar::Util::set_prototype($wrapper, $proto);
+    }
+    return $wrapper;
 }
 
 sub _make_import_sub {
@@ -221,6 +232,9 @@ sub _make_import_sub {
         my $traits;
         ( $traits, @_ ) = _strip_traits(@_);
 
+        my $metaclass;
+        ( $metaclass, @_ ) = _strip_metaclass(@_);
+
         # Normally we could look at $_[0], but in some weird cases
         # (involving goto &Moose::import), $_[0] ends as something
         # else (like Squirrel).
@@ -250,7 +264,7 @@ sub _make_import_sub {
             # Moose::Exporter, which in turn sets $CALLER, so we need
             # to protect against that.
             local $CALLER = $CALLER;
-            $c->init_meta( for_class => $CALLER );
+            $c->init_meta( for_class => $CALLER, metaclass => $metaclass );
             $did_init_meta = 1;
         }
 
@@ -287,12 +301,24 @@ sub _strip_traits {
     return ( $traits, @_ );
 }
 
+sub _strip_metaclass {
+    my $idx = first_index { $_ eq '-metaclass' } @_;
+
+    return ( undef, @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
+
+    my $metaclass = $_[ $idx + 1 ];
+
+    splice @_, $idx, 2;
+
+    return ( $metaclass, @_ );
+}
+
 sub _apply_meta_traits {
     my ( $class, $traits ) = @_;
 
     return unless @{$traits};
 
-    my $meta = $class->meta();
+    my $meta = Class::MOP::class_of($class);
 
     my $type = ( split /::/, ref $meta )[-1]
         or Moose->throw_error(
@@ -365,6 +391,11 @@ sub _remove_keywords {
     }
 }
 
+sub import {
+    strict->import;
+    warnings->import;
+}
+
 1;
 
 __END__
@@ -377,9 +408,6 @@ Moose::Exporter - make an import() and unimport() just like Moose.pm
 
   package MyApp::Moose;
 
-  use strict;
-  use warnings;
-
   use Moose ();
   use Moose::Exporter;
 
@@ -391,7 +419,7 @@ Moose::Exporter - make an import() and unimport() just like Moose.pm
 
   sub has_rw {
       my ($caller, $name, %options) = @_;
-      Class::MOP::Class->initialize($caller)->add_attribute($name,
+      Class::MOP::class_of($caller)->add_attribute($name,
           is => 'rw',
           %options,
       );
@@ -410,19 +438,25 @@ Moose::Exporter - make an import() and unimport() just like Moose.pm
 
 =head1 DESCRIPTION
 
-This module encapsulates the logic to export sugar functions like
-C<Moose.pm>. It does this by building custom C<import> and C<unimport>
-methods for your module, based on a spec your provide.
+This module encapsulates the exporting of sugar functions in a
+C<Moose.pm>-like manner. It does this by building custom C<import> and
+C<unimport> methods for your module, based on a spec you provide.
 
-It also lets your "stack" Moose-alike modules so you can export
+It also lets you "stack" Moose-alike modules so you can export
 Moose's sugar as well as your own, along with sugar from any random
 C<MooseX> module, as long as they all use C<Moose::Exporter>.
 
+To simplify writing exporter modules, C<Moose::Exporter> also imports
+C<strict> and C<warnings> into your exporter module, as well as into
+modules that use it.
+
 =head1 METHODS
 
 This module provides two public methods:
 
-=head2 Moose::Exporter->setup_import_methods(...)
+=over 4
+
+=item  B<< Moose::Exporter->setup_import_methods(...) >>
 
 When you call this method, C<Moose::Exporter> build custom C<import>
 and C<unimport> methods for your module. The import method will export
@@ -434,7 +468,7 @@ exported functions.
 
 This method accepts the following parameters:
 
-=over 4
+=over 8
 
 =item * with_caller => [ ... ]
 
@@ -469,12 +503,14 @@ when C<unimport> is called.
 
 =back
 
-=head2 Moose::Exporter->build_import_methods(...)
+=item B<< Moose::Exporter->build_import_methods(...) >>
 
 Returns two code refs, one for import and one for unimport.
 
 Used by C<setup_import_methods>.
 
+=back
+
 =head1 IMPORTING AND init_meta
 
 If you want to set an alternative base object class or metaclass