X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FExporter.pm;h=dcdef3cbeba1afb3805b1685e46e0e324944d31c;hb=ef487af73b144341c8fd2e4640b93d395dc414ed;hp=e3b564511a0d3630462ed456ff324906a71c7afc;hpb=4cfe8f309a065fc548cdfbe72c5542d72cb2a46d;p=gitmo%2FMoose.git

diff --git a/lib/Moose/Exporter.pm b/lib/Moose/Exporter.pm
index e3b5645..dcdef3c 100644
--- a/lib/Moose/Exporter.pm
+++ b/lib/Moose/Exporter.pm
@@ -3,6 +3,7 @@ package Moose::Exporter;
 use strict;
 use warnings;
 
+use Class::Load qw(is_class_loaded);
 use Class::MOP;
 use List::MoreUtils qw( first_index uniq );
 use Moose::Util::MetaRole;
@@ -28,7 +29,7 @@ sub build_import_methods {
 
     my $exporting_package = $args{exporting_package} ||= caller();
 
-    my $meta_generator = $args{meta_generator} || sub { Class::MOP::class_of(shift) };
+    my $meta_lookup = $args{meta_lookup} || sub { Class::MOP::class_of(shift) };
 
     $EXPORT_SPEC{$exporting_package} = \%args;
 
@@ -38,16 +39,16 @@ sub build_import_methods {
     my $is_reexport     = {};
 
     my $exports = $class->_make_sub_exporter_params(
-        [ @exports_from, $exporting_package ],
+        [ $exporting_package, @exports_from ],
         $export_recorder,
         $is_reexport,
-        $meta_generator,
+        $args{meta_lookup}, # so that we don't pass through the default
     );
 
     my $exporter = $class->_make_exporter(
         $exports,
         $is_reexport,
-        $meta_generator,
+        $meta_lookup,
     );
 
     my %methods;
@@ -56,7 +57,7 @@ sub build_import_methods {
         $exporter,
         \@exports_from,
         $is_reexport,
-        $meta_generator,
+        $meta_lookup,
     );
 
     $methods{unimport} = $class->_make_unimport_sub(
@@ -64,13 +65,13 @@ sub build_import_methods {
         $exports,
         $export_recorder,
         $is_reexport,
-        $meta_generator,
+        $meta_lookup,
     );
 
     $methods{init_meta} = $class->_make_init_meta(
         $exporting_package,
         \%args,
-        $meta_generator,
+        $meta_lookup,
     );
 
     my $package = Class::MOP::Package->initialize($exporting_package);
@@ -86,7 +87,7 @@ sub build_import_methods {
 }
 
 sub _make_exporter {
-    my ($class, $exports, $is_reexport, $meta_generator) = @_;
+    my ($class, $exports, $is_reexport, $meta_lookup) = @_;
 
     return Sub::Exporter::build_exporter(
         {
@@ -94,7 +95,7 @@ sub _make_exporter {
             groups    => { default => [':all'] },
             installer => sub {
                 my ($arg, $to_export) = @_;
-                my $meta = $meta_generator->($arg->{into});
+                my $meta = $meta_lookup->($arg->{into});
 
                 goto &Sub::Exporter::default_installer unless $meta;
 
@@ -137,14 +138,14 @@ sub _make_exporter {
 
         local %$seen = ( $exporting_package => 1 );
 
-        return reverse uniq( _follow_also_real($exporting_package) );
+        return uniq( _follow_also_real($exporting_package) );
     }
 
     sub _follow_also_real {
         my $exporting_package = shift;
 
         if ( !exists $EXPORT_SPEC{$exporting_package} ) {
-            my $loaded = Class::MOP::is_class_loaded($exporting_package);
+            my $loaded = is_class_loaded($exporting_package);
 
             die "Package in also ($exporting_package) does not seem to "
                 . "use Moose::Exporter"
@@ -194,18 +195,25 @@ sub _parse_trait_aliases {
 }
 
 sub _make_sub_exporter_params {
-    my $class           = shift;
-    my $packages        = shift;
-    my $export_recorder = shift;
-    my $is_reexport     = shift;
-    my $meta_generator  = shift;
+    my $class                = shift;
+    my $packages             = shift;
+    my $export_recorder      = shift;
+    my $is_reexport          = shift;
+    my $meta_lookup_override = shift;
 
     my %exports;
+    my $current_meta_lookup;
 
     for my $package ( @{$packages} ) {
         my $args = $EXPORT_SPEC{$package}
             or die "The $package package does not use Moose::Exporter\n";
 
+        $current_meta_lookup = $meta_lookup_override || $args->{meta_lookup};
+        $meta_lookup_override = $current_meta_lookup;
+
+        my $meta_lookup = $current_meta_lookup
+                       || sub { Class::MOP::class_of(shift) };
+
         for my $name ( @{ $args->{with_meta} } ) {
             my $sub = $class->_sub_from_package( $package, $name )
                 or next;
@@ -216,8 +224,8 @@ sub _make_sub_exporter_params {
                 $fq_name,
                 $sub,
                 $export_recorder,
-                $meta_generator,
-            );
+                $meta_lookup,
+            ) unless exists $exports{$name};
         }
 
         for my $name ( @{ $args->{with_caller} } ) {
@@ -230,7 +238,7 @@ sub _make_sub_exporter_params {
                 $fq_name,
                 $sub,
                 $export_recorder,
-            );
+            ) unless exists $exports{$name};
         }
 
         my @extra_exports = $class->_parse_trait_aliases(
@@ -259,7 +267,8 @@ sub _make_sub_exporter_params {
 
             $export_recorder->{$sub} = 1;
 
-            $exports{$coderef_name} = sub {$sub};
+            $exports{$coderef_name} = sub { $sub }
+                unless exists $exports{$coderef_name};
         }
     }
 
@@ -315,14 +324,14 @@ sub _make_wrapped_sub_with_meta {
     my $fq_name         = shift;
     my $sub             = shift;
     my $export_recorder = shift;
-    my $meta_generator  = shift;
+    my $meta_lookup     = shift;
 
     return sub {
         my $caller = $CALLER;
 
         my $wrapper = $self->_late_curry_wrapper(
             $sub, $fq_name,
-            $meta_generator => $caller
+            $meta_lookup => $caller
         );
 
         my $sub = subname( $fq_name => $wrapper );
@@ -378,7 +387,7 @@ sub _make_import_sub {
     my $exporter          = shift;
     my $exports_from      = shift;
     my $is_reexport       = shift;
-    my $meta_generator    = shift;
+    my $meta_lookup       = shift;
 
     return sub {
 
@@ -439,7 +448,7 @@ sub _make_import_sub {
             # Moose::Exporter, which in turn sets $CALLER, so we need
             # to protect against that.
             local $CALLER = $CALLER;
-            _apply_meta_traits( $CALLER, $traits, $meta_generator );
+            _apply_meta_traits( $CALLER, $traits, $meta_lookup );
         }
         elsif ( @{$traits} ) {
             require Moose;
@@ -500,11 +509,11 @@ sub _strip_meta_name {
 }
 
 sub _apply_meta_traits {
-    my ( $class, $traits, $meta_generator ) = @_;
+    my ( $class, $traits, $meta_lookup ) = @_;
 
     return unless @{$traits};
 
-    my $meta = $meta_generator->($class);
+    my $meta = $meta_lookup->($class);
 
     my $type = ( split /::/, ref $meta )[-1]
         or Moose->throw_error(
@@ -550,7 +559,7 @@ sub _make_unimport_sub {
     my $exports           = shift;
     my $export_recorder   = shift;
     my $is_reexport       = shift;
-    my $meta_generator    = shift;
+    my $meta_lookup       = shift;
 
     return sub {
         my $caller = scalar caller();
@@ -596,7 +605,7 @@ sub _make_init_meta {
     shift;
     my $class          = shift;
     my $args           = shift;
-    my $meta_generator = shift;
+    my $meta_lookup    = shift;
 
     my %old_style_roles;
     for my $role (
@@ -629,7 +638,7 @@ sub _make_init_meta {
         shift;
         my %options = @_;
 
-        return unless $meta_generator->( $options{for_class} );
+        return unless $meta_lookup->( $options{for_class} );
 
         if ( %new_style_roles || %old_style_roles ) {
             Moose::Util::MetaRole::apply_metaroles(
@@ -643,10 +652,10 @@ sub _make_init_meta {
             for_class => $options{for_class},
             %base_class_roles,
             )
-            if $meta_generator->( $options{for_class} )
+            if $meta_lookup->( $options{for_class} )
                 ->isa('Moose::Meta::Class');
 
-        return $meta_generator->( $options{for_class} );
+        return $meta_lookup->( $options{for_class} );
     };
 }
 
@@ -781,6 +790,23 @@ can selectively override functions exported by another module.
 C<Moose::Exporter> also makes sure all these functions get removed
 when C<unimport> is called.
 
+=item * meta_lookup => sub { ... }
+
+This is a function which will be called to provide the metaclass
+to be operated upon by the exporter. This is an advanced feature
+intended for use by package generator modules in the vein of
+L<MooseX::Role::Parameterized> in order to simplify reusing sugar
+from other modules that use C<Moose::Exporter>. This function is
+used, for example, to select the metaclass to bind to functions
+that are exported using the C<with_meta> option.
+
+This function will receive one parameter: the class name into which
+the sugar is being exported. The default implementation is:
+
+    sub { Class::MOP::class_of(shift) }
+
+Accordingly, this function is expected to return a metaclass.
+
 =back
 
 You can also provide parameters for C<Moose::Util::MetaRole::apply_metaroles>