X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FExporter.pm;h=dcdef3cbeba1afb3805b1685e46e0e324944d31c;hb=ef487af73b144341c8fd2e4640b93d395dc414ed;hp=70bda3a60933d7fc26de1145fe7d03b8827e3c76;hpb=1365431e33988c9a0fced0bbbd6000071fe0780e;p=gitmo%2FMoose.git diff --git a/lib/Moose/Exporter.pm b/lib/Moose/Exporter.pm index 70bda3a..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; @@ -38,10 +39,10 @@ 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_lookup, + $args{meta_lookup}, # so that we don't pass through the default ); my $exporter = $class->_make_exporter( @@ -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_lookup = 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; @@ -217,7 +225,7 @@ sub _make_sub_exporter_params { $sub, $export_recorder, $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}; } } @@ -783,11 +792,20 @@ when C 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 +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 in order to simplify reusing sugar from other -modules that use C. +L in order to simplify reusing sugar +from other modules that use C. This function is +used, for example, to select the metaclass to bind to functions +that are exported using the C 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