use strict;
use warnings;
-use Carp qw( confess );
+our $VERSION = '0.83';
+$VERSION = eval $VERSION;
+our $AUTHORITY = 'cpan:STEVAN';
+
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;
my $export_recorder = {};
- my $exports = $class->_make_sub_exporter_params(
- [ $exporting_package, @exports_from ], $export_recorder );
+ my ( $exports, $is_removable )
+ = $class->_make_sub_exporter_params(
+ [ @exports_from, $exporting_package ], $export_recorder );
my $exporter = Sub::Exporter::build_exporter(
{
\@exports_from, $args{_export_to_main} );
my $unimport = $class->_make_unimport_sub( $exporting_package, $exports,
- $export_recorder );
+ $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"
- 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};
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;
my $export_recorder = shift;
my %exports;
+ my %is_removable;
for my $package ( @{$packages} ) {
my $args = $EXPORT_SPEC{$package}
$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;
}
}
- return \%exports;
+ return ( \%exports, \%is_removable );
}
-{
- # This variable gets closed over in each export _generator_. Then
- # in the generator we grab the value and close over it _again_ in
- # the real export, so it gets captured each time the generator
- # runs.
- #
- # In the meantime, we arrange for the import method we generate to
- # set this variable to the caller each time it is called.
- #
- # This is all a bit confusing, but it works.
- my $CALLER;
-
- sub _make_wrapped_sub {
- 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
- # package. This lets other packages call Foo::has() and get
- # the right package. This is done for backwards compatibility
- # with existing production code, not because this is a good
- # idea ;)
- return sub {
- my $caller = $CALLER;
-
- my $sub = Class::MOP::subname( $fq_name => sub { $sub->( $caller, @_ ) } );
+our $CALLER;
- $export_recorder->{$sub} = 1;
+sub _make_wrapped_sub {
+ my $self = shift;
+ my $fq_name = shift;
+ my $sub = shift;
+ my $export_recorder = shift;
- return $sub;
- };
- }
+ # We need to set the package at import time, so that when
+ # package Foo imports has(), we capture "Foo" as the
+ # package. This lets other packages call Foo::has() and get
+ # the right package. This is done for backwards compatibility
+ # with existing production code, not because this is a good
+ # idea ;)
+ return sub {
+ my $caller = $CALLER;
- sub _make_import_sub {
- shift;
- my $exporting_package = shift;
- my $exporter = shift;
- my $exports_from = shift;
- my $export_to_main = shift;
-
- return sub {
- # I think we could use Sub::Exporter's collector feature
- # to do this, but that would be rather gross, since that
- # feature isn't really designed to return a value to the
- # caller of the exporter sub.
- #
- # Also, this makes sure we preserve backwards compat for
- # _get_caller, so it always sees the arguments in the
- # expected order.
- my $traits;
- ($traits, @_) = Moose::Exporter::_strip_traits(@_);
-
- # Normally we could look at $_[0], but in some weird cases
- # (involving goto &Moose::import), $_[0] ends as something
- # else (like Squirrel).
- my $class = $exporting_package;
-
- $CALLER = Moose::Exporter::_get_caller(@_);
-
- # this works because both pragmas set $^H (see perldoc
- # perlvar) which affects the current compilation -
- # i.e. the file who use'd us - which is why we don't need
- # to do anything special to make it affect that file
- # rather than this one (which is already compiled)
-
- strict->import;
- warnings->import;
-
- # we should never export to main
- if ( $CALLER eq 'main' && ! $export_to_main ) {
- warn
- qq{$class does not export its sugar to the 'main' package.\n};
- return;
- }
+ my $wrapper = $self->_curry_wrapper($sub, $fq_name, $caller);
- my $did_init_meta;
- for my $c ( grep { $_->can('init_meta') } $class, @{$exports_from} ) {
+ my $sub = subname($fq_name => $wrapper);
- $c->init_meta( for_class => $CALLER );
- $did_init_meta = 1;
- }
+ $export_recorder->{$sub} = 1;
- if ( $did_init_meta && @{$traits} ) {
- _apply_meta_traits( $CALLER, $traits );
- }
- elsif ( @{$traits} ) {
- confess
- "Cannot provide traits when $class does not have an init_meta() method";
- }
+ return $sub;
+ };
+}
- goto $exporter;
- };
+sub _curry_wrapper {
+ my $class = shift;
+ my $sub = shift;
+ my $fq_name = shift;
+ my @extra = @_;
+
+ 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 {
+ shift;
+ my $exporting_package = shift;
+ my $exporter = shift;
+ my $exports_from = shift;
+ my $export_to_main = shift;
+
+ return sub {
+
+ # I think we could use Sub::Exporter's collector feature
+ # to do this, but that would be rather gross, since that
+ # feature isn't really designed to return a value to the
+ # caller of the exporter sub.
+ #
+ # Also, this makes sure we preserve backwards compat for
+ # _get_caller, so it always sees the arguments in the
+ # expected order.
+ 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).
+ my $class = $exporting_package;
+
+ $CALLER = _get_caller(@_);
+
+ # this works because both pragmas set $^H (see perldoc
+ # perlvar) which affects the current compilation -
+ # i.e. the file who use'd us - which is why we don't need
+ # to do anything special to make it affect that file
+ # rather than this one (which is already compiled)
+
+ strict->import;
+ warnings->import;
+
+ # we should never export to main
+ if ( $CALLER eq 'main' && !$export_to_main ) {
+ warn
+ qq{$class does not export its sugar to the 'main' package.\n};
+ return;
+ }
+
+ my $did_init_meta;
+ for my $c ( grep { $_->can('init_meta') } $class, @{$exports_from} ) {
+ # init_meta can apply a role, which when loaded uses
+ # Moose::Exporter, which in turn sets $CALLER, so we need
+ # to protect against that.
+ local $CALLER = $CALLER;
+ $c->init_meta( for_class => $CALLER, metaclass => $metaclass );
+ $did_init_meta = 1;
+ }
+
+ if ( $did_init_meta && @{$traits} ) {
+ # The traits will use Moose::Role, which in turn uses
+ # Moose::Exporter, which in turn sets $CALLER, so we need
+ # to protect against that.
+ local $CALLER = $CALLER;
+ _apply_meta_traits( $CALLER, $traits );
+ }
+ elsif ( @{$traits} ) {
+ require Moose;
+ Moose->throw_error(
+ "Cannot provide traits when $class does not have an init_meta() method"
+ );
+ }
+
+ goto $exporter;
+ };
}
+
sub _strip_traits {
my $idx = first_index { $_ eq '-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 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 => $_ ) }
shift;
my $exporting_package = shift;
my $exports = shift;
+ my $is_removable = shift;
my $export_recorder = shift;
return sub {
Moose::Exporter->_remove_keywords(
$caller,
[ keys %{$exports} ],
+ $is_removable,
$export_recorder,
);
};
shift;
my $package = shift;
my $keywords = shift;
+ my $is_removable = shift;
my $recorded_exports = shift;
no strict 'refs';
foreach my $name ( @{ $keywords } ) {
+ next unless $is_removable->{$name};
if ( defined &{ $package . '::' . $name } ) {
my $sub = \&{ $package . '::' . $name };
}
}
+sub import {
+ strict->import;
+ warnings->import;
+}
+
1;
__END__
package MyApp::Moose;
- use strict;
- use warnings;
-
use Moose ();
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_of($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;
=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
This method accepts the following parameters:
-=over 4
+=over 8
=item * with_caller => [ ... ]
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
wants to export. These modules must also use C<Moose::Exporter>. The
most common use case will be to export the functions from C<Moose.pm>.
+Functions specified by C<with_caller> or C<as_is> take precedence over
+functions exported by modules specified by C<also>, so that a module
+can selectively override functions exported by another module.
C<Moose::Exporter> also makes sure all these functions get removed
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
=head1 COPYRIGHT AND LICENSE
-Copyright 2008 by Infinity Interactive, Inc.
+Copyright 2009 by Infinity Interactive, Inc.
L<http://www.iinteractive.com>