1 package Moose::Exporter;
7 use List::MoreUtils qw( first_index uniq );
8 use Moose::Util::MetaRole;
9 use Scalar::Util qw(reftype);
10 use Sub::Exporter 0.980;
11 use Sub::Name qw(subname);
15 sub setup_import_methods {
16 my ( $class, %args ) = @_;
18 $args{exporting_package} ||= caller();
20 $class->build_import_methods(
22 install => [qw(import unimport init_meta)]
26 sub build_import_methods {
27 my ( $class, %args ) = @_;
29 my $exporting_package = $args{exporting_package} ||= caller();
31 $EXPORT_SPEC{$exporting_package} = \%args;
33 my @exports_from = $class->_follow_also($exporting_package);
35 my $export_recorder = {};
38 my $exports = $class->_make_sub_exporter_params(
39 [ @exports_from, $exporting_package ],
44 my $exporter = $class->_make_exporter($exports, $is_reexport);
47 $methods{import} = $class->_make_import_sub(
54 $methods{unimport} = $class->_make_unimport_sub(
61 $methods{init_meta} = $class->_make_init_meta(
66 my $package = Class::MOP::Package->initialize($exporting_package);
67 for my $to_install ( @{ $args{install} || [] } ) {
68 my $symbol = '&' . $to_install;
70 unless $methods{$to_install}
71 && !$package->has_package_symbol($symbol);
72 $package->add_package_symbol( $symbol, $methods{$to_install} );
75 return ( $methods{import}, $methods{unimport}, $methods{init_meta} );
79 my ($class, $exports, $is_reexport) = @_;
81 return Sub::Exporter::build_exporter(
84 groups => { default => [':all'] },
86 my ($arg, $to_export) = @_;
87 my $meta = Class::MOP::class_of($arg->{into});
89 goto &Sub::Exporter::default_installer unless $meta;
91 # don't overwrite existing symbols with our magically flagged
92 # version of it if we would install the same sub that's already
95 my @filtered_to_export;
97 for (my $i = 0; $i < @{ $to_export }; $i += 2) {
98 my ($as, $cv) = @{ $to_export }[$i, $i + 1];
101 && $meta->has_package_symbol('&' . $as)
102 && $meta->get_package_symbol('&' . $as) == $cv;
104 push @filtered_to_export, $as, $cv;
105 $installed{$as} = 1 unless ref $as;
108 Sub::Exporter::default_installer($arg, \@filtered_to_export);
110 for my $name ( keys %{$is_reexport} ) {
113 next unless exists $installed{$name};
114 _flag_as_reexport( \*{ join q{::}, $arg->{into}, $name } );
126 my $exporting_package = shift;
128 local %$seen = ( $exporting_package => 1 );
130 return reverse uniq( _follow_also_real($exporting_package) );
133 sub _follow_also_real {
134 my $exporting_package = shift;
136 if ( !exists $EXPORT_SPEC{$exporting_package} ) {
137 my $loaded = Class::MOP::is_class_loaded($exporting_package);
139 die "Package in also ($exporting_package) does not seem to "
140 . "use Moose::Exporter"
141 . ( $loaded ? "" : " (is it loaded?)" );
144 my $also = $EXPORT_SPEC{$exporting_package}{also};
146 return unless defined $also;
148 my @also = ref $also ? @{$also} : $also;
150 for my $package (@also) {
152 "Circular reference in 'also' parameter to Moose::Exporter between $exporting_package and $package"
153 if $seen->{$package};
155 $seen->{$package} = 1;
158 return @also, map { _follow_also_real($_) } @also;
162 sub _parse_trait_aliases {
164 my ($package, $aliases) = @_;
167 for my $alias (@$aliases) {
170 reftype($alias) eq 'ARRAY'
171 or Moose->throw_error(reftype($alias) . " references are not "
172 . "valid arguments to the 'trait_aliases' "
175 ($alias, $name) = @$alias;
178 ($name = $alias) =~ s/.*:://;
180 push @ret, subname "${package}::${name}" => sub () { $alias };
186 sub _make_sub_exporter_params {
188 my $packages = shift;
189 my $export_recorder = shift;
190 my $is_reexport = shift;
194 for my $package ( @{$packages} ) {
195 my $args = $EXPORT_SPEC{$package}
196 or die "The $package package does not use Moose::Exporter\n";
198 for my $name ( @{ $args->{with_meta} } ) {
199 my $sub = $class->_sub_from_package( $package, $name )
202 my $fq_name = $package . '::' . $name;
204 $exports{$name} = $class->_make_wrapped_sub_with_meta(
211 for my $name ( @{ $args->{with_caller} } ) {
212 my $sub = $class->_sub_from_package( $package, $name )
215 my $fq_name = $package . '::' . $name;
217 $exports{$name} = $class->_make_wrapped_sub(
224 my @extra_exports = $class->_parse_trait_aliases(
225 $package, $args->{trait_aliases},
227 for my $name ( @{ $args->{as_is} }, @extra_exports ) {
228 my ( $sub, $coderef_name );
234 ( $coderef_pkg, $coderef_name )
235 = Class::MOP::get_code_info($name);
237 if ( $coderef_pkg ne $package ) {
238 $is_reexport->{$coderef_name} = 1;
242 $sub = $class->_sub_from_package( $package, $name )
245 $coderef_name = $name;
248 $export_recorder->{$sub} = 1;
250 $exports{$coderef_name} = sub {$sub};
257 sub _sub_from_package {
264 \&{ $package . '::' . $name };
267 return $sub if defined &$sub;
269 Carp::cluck "Trying to export undefined sub ${package}::${name}";
276 sub _make_wrapped_sub {
280 my $export_recorder = shift;
282 # We need to set the package at import time, so that when
283 # package Foo imports has(), we capture "Foo" as the
284 # package. This lets other packages call Foo::has() and get
285 # the right package. This is done for backwards compatibility
286 # with existing production code, not because this is a good
289 my $caller = $CALLER;
291 my $wrapper = $self->_curry_wrapper( $sub, $fq_name, $caller );
293 my $sub = subname( $fq_name => $wrapper );
295 $export_recorder->{$sub} = 1;
301 sub _make_wrapped_sub_with_meta {
305 my $export_recorder = shift;
308 my $caller = $CALLER;
310 my $wrapper = $self->_late_curry_wrapper(
312 sub { Class::MOP::class_of(shift) } => $caller
315 my $sub = subname( $fq_name => $wrapper );
317 $export_recorder->{$sub} = 1;
329 my $wrapper = sub { $sub->( @extra, @_ ) };
330 if ( my $proto = prototype $sub ) {
332 # XXX - Perl's prototype sucks. Use & to make set_prototype
333 # ignore the fact that we're passing "private variables"
334 &Scalar::Util::set_prototype( $wrapper, $proto );
339 sub _late_curry_wrapper {
348 # resolve curried arguments at runtime via this closure
349 my @curry = ( $extra->(@ex_args) );
350 return $sub->( @curry, @_ );
353 if ( my $proto = prototype $sub ) {
355 # XXX - Perl's prototype sucks. Use & to make set_prototype
356 # ignore the fact that we're passing "private variables"
357 &Scalar::Util::set_prototype( $wrapper, $proto );
362 sub _make_import_sub {
364 my $exporting_package = shift;
365 my $exporter = shift;
366 my $exports_from = shift;
367 my $is_reexport = shift;
371 # I think we could use Sub::Exporter's collector feature
372 # to do this, but that would be rather gross, since that
373 # feature isn't really designed to return a value to the
374 # caller of the exporter sub.
376 # Also, this makes sure we preserve backwards compat for
377 # _get_caller, so it always sees the arguments in the
380 ( $traits, @_ ) = _strip_traits(@_);
383 ( $metaclass, @_ ) = _strip_metaclass(@_);
385 = Moose::Util::resolve_metaclass_alias( 'Class' => $metaclass )
386 if defined $metaclass && length $metaclass;
389 ( $meta_name, @_ ) = _strip_meta_name(@_);
391 # Normally we could look at $_[0], but in some weird cases
392 # (involving goto &Moose::import), $_[0] ends as something
393 # else (like Squirrel).
394 my $class = $exporting_package;
396 $CALLER = _get_caller(@_);
398 # this works because both pragmas set $^H (see perldoc
399 # perlvar) which affects the current compilation -
400 # i.e. the file who use'd us - which is why we don't need
401 # to do anything special to make it affect that file
402 # rather than this one (which is already compiled)
408 for my $c ( grep { $_->can('init_meta') } $class, @{$exports_from} ) {
410 # init_meta can apply a role, which when loaded uses
411 # Moose::Exporter, which in turn sets $CALLER, so we need
412 # to protect against that.
413 local $CALLER = $CALLER;
415 for_class => $CALLER,
416 metaclass => $metaclass,
417 meta_name => $meta_name,
422 if ( $did_init_meta && @{$traits} ) {
424 # The traits will use Moose::Role, which in turn uses
425 # Moose::Exporter, which in turn sets $CALLER, so we need
426 # to protect against that.
427 local $CALLER = $CALLER;
428 _apply_meta_traits( $CALLER, $traits );
430 elsif ( @{$traits} ) {
433 "Cannot provide traits when $class does not have an init_meta() method"
437 my ( undef, @args ) = @_;
438 my $extra = shift @args if ref $args[0] eq 'HASH';
441 if ( !$extra->{into} ) {
442 $extra->{into_level} ||= 0;
443 $extra->{into_level}++;
446 $class->$exporter( $extra, @args );
451 my $idx = first_index { ( $_ || '' ) eq '-traits' } @_;
453 return ( [], @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
455 my $traits = $_[ $idx + 1 ];
459 $traits = [$traits] unless ref $traits;
461 return ( $traits, @_ );
464 sub _strip_metaclass {
465 my $idx = first_index { ( $_ || '' ) eq '-metaclass' } @_;
467 return ( undef, @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
469 my $metaclass = $_[ $idx + 1 ];
473 return ( $metaclass, @_ );
476 sub _strip_meta_name {
477 my $idx = first_index { ( $_ || '' ) eq '-meta_name' } @_;
479 return ( 'meta', @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
481 my $meta_name = $_[ $idx + 1 ];
485 return ( $meta_name, @_ );
488 sub _apply_meta_traits {
489 my ( $class, $traits ) = @_;
491 return unless @{$traits};
493 my $meta = Class::MOP::class_of($class);
495 my $type = ( split /::/, ref $meta )[-1]
496 or Moose->throw_error(
497 'Cannot determine metaclass type for trait application . Meta isa '
500 my @resolved_traits = map {
503 : Moose::Util::resolve_metatrait_alias( $type => $_ )
506 return unless @resolved_traits;
508 my %args = ( for => $class );
510 if ( $meta->isa('Moose::Meta::Role') ) {
511 $args{role_metaroles} = { role => \@resolved_traits };
514 $args{class_metaroles} = { class => \@resolved_traits };
517 Moose::Util::MetaRole::apply_metaroles(%args);
522 # 1 extra level because it's called by import so there's a layer
527 ( ref $_[1] && defined $_[1]->{into} ) ? $_[1]->{into}
528 : ( ref $_[1] && defined $_[1]->{into_level} )
529 ? caller( $offset + $_[1]->{into_level} )
533 sub _make_unimport_sub {
535 my $exporting_package = shift;
537 my $export_recorder = shift;
538 my $is_reexport = shift;
541 my $caller = scalar caller();
542 Moose::Exporter->_remove_keywords(
544 [ keys %{$exports} ],
551 sub _remove_keywords {
554 my $keywords = shift;
555 my $recorded_exports = shift;
556 my $is_reexport = shift;
560 foreach my $name ( @{$keywords} ) {
561 if ( defined &{ $package . '::' . $name } ) {
562 my $sub = \&{ $package . '::' . $name };
564 # make sure it is from us
565 next unless $recorded_exports->{$sub};
567 if ( $is_reexport->{$name} ) {
570 unless _export_is_flagged(
571 \*{ join q{::} => $package, $name } );
574 # and if it is from us, then undef the slot
575 delete ${ $package . '::' }{$name};
580 sub _make_init_meta {
592 wrapped_method_metaclass
599 $old_style_roles{$role} = $args->{$role}
600 if exists $args->{$role};
603 my %base_class_roles;
604 %base_class_roles = ( roles => $args->{base_class_roles} )
605 if exists $args->{base_class_roles};
607 my %new_style_roles = map { $_ => $args->{$_} }
608 grep { exists $args->{$_} } qw( class_metaroles role_metaroles );
610 return unless %new_style_roles || %old_style_roles || %base_class_roles;
616 return unless Class::MOP::class_of( $options{for_class} );
618 if ( %new_style_roles || %old_style_roles ) {
619 Moose::Util::MetaRole::apply_metaroles(
620 for => $options{for_class},
626 Moose::Util::MetaRole::apply_base_class_roles(
627 for_class => $options{for_class},
630 if Class::MOP::class_of( $options{for_class} )
631 ->isa('Moose::Meta::Class');
633 return Class::MOP::class_of( $options{for_class} );
644 # ABSTRACT: make an import() and unimport() just like Moose.pm
650 package MyApp::Moose;
655 Moose::Exporter->setup_import_methods(
656 with_meta => [ 'has_rw', 'sugar2' ],
657 as_is => [ 'sugar3', \&Some::Random::thing ],
662 my ( $meta, $name, %options ) = @_;
663 $meta->add_attribute(
683 This module encapsulates the exporting of sugar functions in a
684 C<Moose.pm>-like manner. It does this by building custom C<import>,
685 C<unimport>, and C<init_meta> methods for your module, based on a spec you
688 It also lets you "stack" Moose-alike modules so you can export Moose's sugar
689 as well as your own, along with sugar from any random C<MooseX> module, as
690 long as they all use C<Moose::Exporter>. This feature exists to let you bundle
691 a set of MooseX modules into a policy module that developers can use directly
692 instead of using Moose itself.
694 To simplify writing exporter modules, C<Moose::Exporter> also imports
695 C<strict> and C<warnings> into your exporter module, as well as into
700 This module provides two public methods:
704 =item B<< Moose::Exporter->setup_import_methods(...) >>
706 When you call this method, C<Moose::Exporter> builds custom C<import>,
707 C<unimport>, and C<init_meta> methods for your module. The C<import> method
708 will export the functions you specify, and can also re-export functions
709 exported by some other module (like C<Moose.pm>).
711 The C<unimport> method cleans the caller's namespace of all the exported
712 functions. This includes any functions you re-export from other
713 packages. However, if the consumer of your package also imports those
714 functions from the original package, they will I<not> be cleaned.
716 If you pass any parameters for L<Moose::Util::MetaRole>, this method will
717 generate an C<init_meta> for you as well (see below for details). This
718 C<init_meta> will call C<Moose::Util::MetaRole::apply_metaroles> and
719 C<Moose::Util::MetaRole::apply_base_class_roles> as needed.
721 Note that if any of these methods already exist, they will not be
722 overridden, you will have to use C<build_import_methods> to get the
723 coderef that would be installed.
725 This method accepts the following parameters:
729 =item * with_meta => [ ... ]
731 This list of function I<names only> will be wrapped and then exported. The
732 wrapper will pass the metaclass object for the caller as its first argument.
734 Many sugar functions will need to use this metaclass object to do something to
737 =item * as_is => [ ... ]
739 This list of function names or sub references will be exported as-is. You can
740 identify a subroutine by reference, which is handy to re-export some other
741 module's functions directly by reference (C<\&Some::Package::function>).
743 If you do export some other package's function, this function will never be
744 removed by the C<unimport> method. The reason for this is we cannot know if
745 the caller I<also> explicitly imported the sub themselves, and therefore wants
748 =item * trait_aliases => [ ... ]
750 This is a list of package names which should have shortened aliases exported,
751 similar to the functionality of L<aliased>. Each element in the list can be
752 either a package name, in which case the export will be named as the last
753 namespace component of the package, or an arrayref, whose first element is the
754 package to alias to, and second element is the alias to export.
756 =item * also => $name or \@names
758 This is a list of modules which contain functions that the caller
759 wants to export. These modules must also use C<Moose::Exporter>. The
760 most common use case will be to export the functions from C<Moose.pm>.
761 Functions specified by C<with_meta> or C<as_is> take precedence over
762 functions exported by modules specified by C<also>, so that a module
763 can selectively override functions exported by another module.
765 C<Moose::Exporter> also makes sure all these functions get removed
766 when C<unimport> is called.
770 You can also provide parameters for C<Moose::Util::MetaRole::apply_metaroles>
771 and C<Moose::Util::MetaRole::base_class_roles>. Specifically, valid parameters
772 are "class_metaroles", "role_metaroles", and "base_class_roles".
774 =item B<< Moose::Exporter->build_import_methods(...) >>
776 Returns two or three code refs, one for C<import>, one for
777 C<unimport>, and optionally one for C<init_meta>, if the appropriate
778 options are passed in.
780 Accepts the additional C<install> option, which accepts an arrayref of method
781 names to install into your exporting package. The valid options are C<import>,
782 C<unimport>, and C<init_meta>. Calling C<setup_import_methods> is equivalent
783 to calling C<build_import_methods> with C<< install => [qw(import unimport
784 init_meta)] >> except that it doesn't also return the methods.
786 Used by C<setup_import_methods>.
790 =head1 IMPORTING AND init_meta
792 If you want to set an alternative base object class or metaclass class, see
793 above for details on how this module can call L<Moose::Util::MetaRole> for
796 If you want to do something that is not supported by this module, simply
797 define an C<init_meta> method in your class. The C<import> method that
798 C<Moose::Exporter> generates for you will call this method (if it exists). It
799 will always pass the caller to this method via the C<for_class> parameter.
801 Most of the time, your C<init_meta> method will probably just call C<<
802 Moose->init_meta >> to do the real work:
805 shift; # our class name
806 return Moose->init_meta( @_, metaclass => 'My::Metaclass' );
809 Keep in mind that C<build_import_methods> will return an C<init_meta>
810 method for you, which you can also call from within your custom
813 my ( $import, $unimport, $init_meta ) =
814 Moose::Exporter->build_import_methods( ... );
821 $class->$import(...);
826 sub unimport { goto &$unimport }
833 $class->$init_meta(...);
838 =head1 METACLASS TRAITS
840 The C<import> method generated by C<Moose::Exporter> will allow the
841 user of your module to specify metaclass traits in a C<-traits>
842 parameter passed as part of the import:
844 use Moose -traits => 'My::Meta::Trait';
846 use Moose -traits => [ 'My::Meta::Trait', 'My::Other::Trait' ];
848 These traits will be applied to the caller's metaclass
849 instance. Providing traits for an exporting class that does not create
850 a metaclass for the caller is an error.
854 See L<Moose/BUGS> for details on reporting bugs.