use strict;
use warnings;
-use Carp qw( confess );
use Class::MOP;
use List::MoreUtils qw( first_index uniq );
use Moose::Util::MetaRole;
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(
{
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 )
}
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};
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;
}
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";
\&{ $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} } ) {
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 );
}
{
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
# 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;
};
}
_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;
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 => $_ ) }
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};
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;
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<unimport> method. The reason for this is we
+cannot know if the caller I<also> 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
projects / gitmo/Moose.git / blobdiff