use strict;
use warnings;
+use Carp qw( confess );
use Class::MOP;
-use List::MoreUtils qw( uniq );
+use List::MoreUtils qw( first_index uniq );
use Sub::Exporter;
my %EXPORT_SPEC;
+sub setup_import_methods {
+ my ( $class, %args ) = @_;
+
+ my $exporting_package = $args{exporting_package} ||= caller();
+
+ my ( $import, $unimport ) = $class->build_import_methods(%args);
+
+ no strict 'refs';
+ *{ $exporting_package . '::import' } = $import;
+ *{ $exporting_package . '::unimport' } = $unimport;
+}
+
sub build_import_methods {
- my $class = shift;
- my %args = @_;
+ my ( $class, %args ) = @_;
- my $exporting_package = caller();
+ my $exporting_package = $args{exporting_package} ||= caller();
$EXPORT_SPEC{$exporting_package} = \%args;
my @exports_from = $class->_follow_also( $exporting_package );
my $exports
- = $class->_process_exports( $exporting_package, @exports_from );
+ = $class->_make_sub_exporter_params( $exporting_package, @exports_from );
my $exporter = Sub::Exporter::build_exporter(
{
}
);
- my $import = $class->_make_import_sub( $exporter, \@exports_from );
+ # $args{_export_to_main} exists for backwards compat, because
+ # Moose::Util::TypeConstraints did export to main (unlike Moose &
+ # Moose::Role).
+ my $import = $class->_make_import_sub( $exporting_package, $exporter,
+ \@exports_from, $args{_export_to_main} );
- my $unimport = $class->_make_unimport_sub( \@exports_from, [ keys %{$exports} ] );
+ my $unimport
+ = $class->_make_unimport_sub( $exporting_package, \@exports_from,
+ [ keys %{$exports} ] );
- no strict 'refs';
- *{ $exporting_package . '::import' } = $import;
- *{ $exporting_package . '::unimport' } = $unimport;
+ return ( $import, $unimport )
}
{
- my %seen;
+ my $seen = {};
sub _follow_also {
my $class = shift;
my $exporting_package = shift;
- %seen = ( $exporting_package => 1 );
+ local %$seen = ( $exporting_package => 1 );
return uniq( _follow_also_real($exporting_package) );
}
for my $package (@also)
{
die "Circular reference in also parameter to MooseX::Exporter between $exporting_package and $package"
- if $seen{$package};
+ if $seen->{$package};
- $seen{$package} = 1;
+ $seen->{$package} = 1;
}
return @also, map { _follow_also_real($_) } @also;
}
}
-sub _process_exports {
+sub _make_sub_exporter_params {
my $class = shift;
my @packages = @_;
sub _make_import_sub {
shift;
- my $exporter = shift;
- my $exports_from = shift;
+ my $exporting_package = shift;
+ my $exporter = shift;
+ my $exports_from = shift;
+ my $export_to_main = shift;
return sub {
-
- # It's important to leave @_ as-is for the benefit of
- # Sub::Exporter.
- my $class = $_[0];
+ # 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(@_);
warnings->import;
# we should never export to main
- if ( $CALLER eq 'main' ) {
+ if ( $CALLER eq 'main' && ! $export_to_main ) {
warn
qq{$class does not export its sugar to the 'main' package.\n};
return;
}
- for my $c (grep { $_->can('init_meta') } $class, @{$exports_from} ) {
+ my $did_init_meta;
+ for my $c ( grep { $_->can('init_meta') } $class, @{$exports_from} ) {
$c->init_meta( for_class => $CALLER );
+ $did_init_meta = 1;
+ }
+
+ if ($did_init_meta) {
+ _apply_meta_traits( $CALLER, $traits );
+ }
+ elsif ( $traits && @{$traits} ) {
+ confess
+ "Cannot provide traits when $class does not have an init_meta() method";
}
goto $exporter;
}
}
+sub _strip_traits {
+ my $idx = first_index { $_ eq '-traits' } @_;
+
+ return ( undef, @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
+
+ my $traits = $_[ $idx + 1 ];
+
+ splice @_, $idx, 2;
+
+ $traits = [ $traits ] unless ref $traits;
+
+ return ( $traits, @_ );
+}
+
+sub _apply_meta_traits {
+ my ( $class, $traits ) = @_;
+
+ return
+ unless $traits && @$traits;
+
+ my $meta = $class->meta();
+
+ my $type = ( split /::/, ref $meta )[-1]
+ or confess
+ 'Cannot determine metaclass type for trait application . Meta isa '
+ . ref $meta;
+
+ # We can only call does_role() on Moose::Meta::Class objects, and
+ # we can only do that on $meta->meta() if it has already had at
+ # least one trait applied to it. By default $meta->meta() returns
+ # a Class::MOP::Class object (not a Moose::Meta::Class).
+ my @traits = grep {
+ $meta->meta()->can('does_role')
+ ? not $meta->meta()->does_role($_)
+ : 1
+ }
+ map { Moose::Util::resolve_metatrait_alias( $type => $_ ) } @$traits;
+
+ return unless @traits;
+
+ Moose::Util::apply_all_roles_with_method( $meta,
+ 'apply_to_metaclass_instance', \@traits );
+}
+
sub _get_caller {
# 1 extra level because it's called by import so there's a layer
# of indirection
sub _make_unimport_sub {
shift;
- my $sources = shift;
- my $keywords = shift;
+ my $exporting_package = shift;
+ my $sources = shift;
+ my $keywords = shift;
return sub {
- my $class = shift;
my $caller = scalar caller();
Moose::Exporter->_remove_keywords(
$caller,
- [ $class, @{$sources} ],
+ [ $exporting_package, @{$sources} ],
$keywords
);
};
use Moose ();
use Moose::Exporter;
- Moose::Exporter->build_export_methods(
- export => [ 'sugar1', 'sugar2', \&Some::Random::thing ],
- init_meta_args => { metaclass_class => 'MyApp::Meta::Class' ],
+ Moose::Exporter->setup_import_methods(
+ with_caller => [ 'sugar1', 'sugar2' ],
+ as_is => [ 'sugar3', \&Some::Random::thing ],
+ also => 'Moose',
);
# then later ...
=head1 METHODS
-This module provides exactly one public method:
+This module provides two public methods:
-=head2 Moose::Exporter->build_import_methods(...)
+=head2 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
=back
+=head2 Moose::Exporter->build_import_methods(...)
+
+Returns two code refs, one for import and one for unimport.
+
+Used by C<setup_import_methods>.
+
=head1 IMPORTING AND init_meta
If you want to set an alternative base object class or metaclass
return Moose->init_meta( @_, metaclass => 'My::Metaclass' );
}
+=head1 METACLASS TRAITS
+
+The C<import> method generated by C<Moose::Exporter> will allow the
+user of your module to specify metaclass traits in a C<-traits>
+parameter passed as part of the import:
+
+ use Moose -traits => 'My::Meta::Trait';
+
+ use Moose -traits => [ 'My::Meta::Trait', 'My::Other::Trait' ];
+
+These traits will be applied to the caller's metaclass
+instance. Providing traits for an exporting class that does not create
+a metaclass for the caller is an error.
+
=head1 AUTHOR
Dave Rolsky E<lt>autarch@urth.orgE<gt>
projects / gitmo/Moose.git / blobdiff