X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FExporter.pm;h=b05fc7762c35d22aac59ea710b066a51799db9be;hb=8b55a35ca65c2335501849c125c8e8c45cbf623d;hp=fe3bc4a75966dcc06a431df61deec1d89c169bd1;hpb=72d15b838f9f72a7fe7dcc1570c4b445d9252c2b;p=gitmo%2FMoose.git diff --git a/lib/Moose/Exporter.pm b/lib/Moose/Exporter.pm index fe3bc4a..b05fc77 100644 --- a/lib/Moose/Exporter.pm +++ b/lib/Moose/Exporter.pm @@ -3,7 +3,6 @@ package Moose::Exporter; use strict; use warnings; -use Carp qw( confess ); use Class::MOP; use List::MoreUtils qw( first_index uniq ); use Moose::Util::MetaRole; @@ -33,8 +32,11 @@ sub build_import_methods { my @exports_from = $class->_follow_also( $exporting_package ); - my $exports - = $class->_make_sub_exporter_params( $exporting_package, @exports_from ); + my $export_recorder = {}; + + my ( $exports, $is_removable ) + = $class->_make_sub_exporter_params( + [ $exporting_package, @exports_from ], $export_recorder ); my $exporter = Sub::Exporter::build_exporter( { @@ -49,9 +51,8 @@ sub build_import_methods { my $import = $class->_make_import_sub( $exporting_package, $exporter, \@exports_from, $args{_export_to_main} ); - my $unimport - = $class->_make_unimport_sub( $exporting_package, \@exports_from, - [ keys %{$exports} ] ); + my $unimport = $class->_make_unimport_sub( $exporting_package, $exports, + $is_removable, $export_recorder ); return ( $import, $unimport ) } @@ -71,7 +72,7 @@ sub build_import_methods { sub _follow_also_real { my $exporting_package = shift; - die "Package in also ($exporting_package) does not seem to use MooseX::Exporter" + die "Package in also ($exporting_package) does not seem to use Moose::Exporter" unless exists $EXPORT_SPEC{$exporting_package}; my $also = $EXPORT_SPEC{$exporting_package}{also}; @@ -82,7 +83,7 @@ sub build_import_methods { for my $package (@also) { - die "Circular reference in also parameter to MooseX::Exporter between $exporting_package and $package" + die "Circular reference in also parameter to Moose::Exporter between $exporting_package and $package" if $seen->{$package}; $seen->{$package} = 1; @@ -93,12 +94,14 @@ sub build_import_methods { } sub _make_sub_exporter_params { - my $class = shift; - my @packages = @_; + my $class = shift; + my $packages = shift; + my $export_recorder = shift; my %exports; + my %is_removable; - for my $package (@packages) { + for my $package ( @{$packages} ) { my $args = $EXPORT_SPEC{$package} or die "The $package package does not use Moose::Exporter\n"; @@ -108,11 +111,15 @@ sub _make_sub_exporter_params { \&{ $package . '::' . $name }; }; + my $fq_name = $package . '::' . $name; + $exports{$name} = $class->_make_wrapped_sub( - $package, - $name, - $sub + $fq_name, + $sub, + $export_recorder, ); + + $is_removable{$name} = 1; } for my $name ( @{ $args->{as_is} } ) { @@ -120,20 +127,38 @@ sub _make_sub_exporter_params { if ( ref $name ) { $sub = $name; - $name = ( Class::MOP::get_code_info($name) )[1]; + + # Even though Moose re-exports things from Carp & + # Scalar::Util, we don't want to remove those at + # unimport time, because the importing package may + # have imported them explicitly ala + # + # use Carp qw( confess ); + # + # This is a hack. Since we can't know whether they + # really want to keep these subs or not, we err on the + # safe side and leave them in. + my $coderef_pkg; + ( $coderef_pkg, $name ) = Class::MOP::get_code_info($name); + + $is_removable{$name} = $coderef_pkg eq $package ? 1 : 0; } else { $sub = do { no strict 'refs'; \&{ $package . '::' . $name }; }; + + $is_removable{$name} = 1; } + $export_recorder->{$sub} = 1; + $exports{$name} = sub {$sub}; } } - return \%exports; + return ( \%exports, \%is_removable ); } { @@ -149,10 +174,11 @@ sub _make_sub_exporter_params { my $CALLER; sub _make_wrapped_sub { - my $class = shift; - my $exporting_package = shift; - my $name = shift; - my $sub = shift; + shift; + my $fq_name = shift; + my $sub = shift; + my $export_recorder = shift; + # We need to set the package at import time, so that when # package Foo imports has(), we capture "Foo" as the @@ -162,8 +188,12 @@ sub _make_sub_exporter_params { # idea ;) return sub { my $caller = $CALLER; - Class::MOP::subname( $exporting_package . '::' - . $name => sub { $sub->( $caller, @_ ) } ); + + my $sub = Class::MOP::subname( $fq_name => sub { $sub->( $caller, @_ ) } ); + + $export_recorder->{$sub} = 1; + + return $sub; }; } @@ -220,8 +250,7 @@ sub _make_sub_exporter_params { _apply_meta_traits( $CALLER, $traits ); } elsif ( @{$traits} ) { - confess - "Cannot provide traits when $class does not have an init_meta() method"; + Moose->throw_error("Cannot provide traits when $class does not have an init_meta() method"); } goto $exporter; @@ -251,9 +280,9 @@ sub _apply_meta_traits { my $meta = $class->meta(); my $type = ( split /::/, ref $meta )[-1] - or confess + or Moose->throw_error( 'Cannot determine metaclass type for trait application . Meta isa ' - . ref $meta; + . ref $meta ); my @resolved_traits = map { Moose::Util::resolve_metatrait_alias( $type => $_ ) } @@ -282,39 +311,38 @@ sub _get_caller { sub _make_unimport_sub { shift; my $exporting_package = shift; - my $sources = shift; - my $keywords = shift; + my $exports = shift; + my $is_removable = shift; + my $export_recorder = shift; return sub { my $caller = scalar caller(); Moose::Exporter->_remove_keywords( $caller, - [ $exporting_package, @{$sources} ], - $keywords + [ keys %{$exports} ], + $is_removable, + $export_recorder, ); }; } sub _remove_keywords { shift; - my $package = shift; - my $sources = shift; - my $keywords = shift; - - my %sources = map { $_ => 1 } @{$sources}; + my $package = shift; + my $keywords = shift; + my $is_removable = shift; + my $recorded_exports = shift; no strict 'refs'; - # loop through the keywords ... - foreach my $name ( @{$keywords} ) { + foreach my $name ( @{ $keywords } ) { + next unless $is_removable->{$name}; - # if we find one ... if ( defined &{ $package . '::' . $name } ) { - my $keyword = \&{ $package . '::' . $name }; + my $sub = \&{ $package . '::' . $name }; # make sure it is from us - my ($pkg_name) = Class::MOP::get_code_info($keyword); - next unless $sources{$pkg_name}; + next unless $recorded_exports->{$sub}; # and if it is from us, then undef the slot delete ${ $package . '::' }{$name}; @@ -341,18 +369,26 @@ Moose::Exporter - make an import() and unimport() just like Moose.pm use Moose::Exporter; Moose::Exporter->setup_import_methods( - with_caller => [ 'sugar1', 'sugar2' ], + with_caller => [ 'has_rw', 'sugar2' ], as_is => [ 'sugar3', \&Some::Random::thing ], also => 'Moose', ); + sub has_rw { + my ($caller, $name, %options) = @_; + Class::MOP::Class->initialize($caller)->add_attribute($name, + is => 'rw', + %options, + ); + } + # then later ... package MyApp::User; use MyApp::Moose; has 'name'; - sugar1 'do your thing'; + has_rw 'size'; thing; no MyApp::Moose; @@ -399,6 +435,11 @@ as-is. You can identify a subroutine by reference, which is handy to re-export some other module's functions directly by reference (C<\&Some::Package::function>). +If you do export some other packages function, this function will +never be removed by the C method. The reason for this is we +cannot know if the caller I explicitly imported the sub +themselves, and therefore wants to keep it. + =item * also => $name or \@names This is a list of modules which contain functions that the caller