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 my $meta_generator = $args{meta_generator} || sub { Class::MOP::class_of(shift) };
33 $EXPORT_SPEC{$exporting_package} = \%args;
35 my @exports_from = $class->_follow_also($exporting_package);
37 my $export_recorder = {};
40 my $exports = $class->_make_sub_exporter_params(
41 [ @exports_from, $exporting_package ],
47 my $exporter = $class->_make_exporter(
54 $methods{import} = $class->_make_import_sub(
62 $methods{unimport} = $class->_make_unimport_sub(
70 $methods{init_meta} = $class->_make_init_meta(
76 my $package = Class::MOP::Package->initialize($exporting_package);
77 for my $to_install ( @{ $args{install} || [] } ) {
78 my $symbol = '&' . $to_install;
80 unless $methods{$to_install}
81 && !$package->has_package_symbol($symbol);
82 $package->add_package_symbol( $symbol, $methods{$to_install} );
85 return ( $methods{import}, $methods{unimport}, $methods{init_meta} );
89 my ($class, $exports, $is_reexport, $meta_generator) = @_;
91 return Sub::Exporter::build_exporter(
94 groups => { default => [':all'] },
96 my ($arg, $to_export) = @_;
97 my $meta = $meta_generator->($arg->{into});
99 goto &Sub::Exporter::default_installer unless $meta;
101 # don't overwrite existing symbols with our magically flagged
102 # version of it if we would install the same sub that's already
105 my @filtered_to_export;
107 for (my $i = 0; $i < @{ $to_export }; $i += 2) {
108 my ($as, $cv) = @{ $to_export }[$i, $i + 1];
111 && $meta->has_package_symbol('&' . $as)
112 && $meta->get_package_symbol('&' . $as) == $cv;
114 push @filtered_to_export, $as, $cv;
115 $installed{$as} = 1 unless ref $as;
118 Sub::Exporter::default_installer($arg, \@filtered_to_export);
120 for my $name ( keys %{$is_reexport} ) {
123 next unless exists $installed{$name};
124 _flag_as_reexport( \*{ join q{::}, $arg->{into}, $name } );
136 my $exporting_package = shift;
138 local %$seen = ( $exporting_package => 1 );
140 return reverse uniq( _follow_also_real($exporting_package) );
143 sub _follow_also_real {
144 my $exporting_package = shift;
146 if ( !exists $EXPORT_SPEC{$exporting_package} ) {
147 my $loaded = Class::MOP::is_class_loaded($exporting_package);
149 die "Package in also ($exporting_package) does not seem to "
150 . "use Moose::Exporter"
151 . ( $loaded ? "" : " (is it loaded?)" );
154 my $also = $EXPORT_SPEC{$exporting_package}{also};
156 return unless defined $also;
158 my @also = ref $also ? @{$also} : $also;
160 for my $package (@also) {
162 "Circular reference in 'also' parameter to Moose::Exporter between $exporting_package and $package"
163 if $seen->{$package};
165 $seen->{$package} = 1;
168 return @also, map { _follow_also_real($_) } @also;
172 sub _parse_trait_aliases {
174 my ($package, $aliases) = @_;
177 for my $alias (@$aliases) {
180 reftype($alias) eq 'ARRAY'
181 or Moose->throw_error(reftype($alias) . " references are not "
182 . "valid arguments to the 'trait_aliases' "
185 ($alias, $name) = @$alias;
188 ($name = $alias) =~ s/.*:://;
190 push @ret, subname "${package}::${name}" => sub () { $alias };
196 sub _make_sub_exporter_params {
198 my $packages = shift;
199 my $export_recorder = shift;
200 my $is_reexport = shift;
201 my $meta_generator = shift;
205 for my $package ( @{$packages} ) {
206 my $args = $EXPORT_SPEC{$package}
207 or die "The $package package does not use Moose::Exporter\n";
209 for my $name ( @{ $args->{with_meta} } ) {
210 my $sub = $class->_sub_from_package( $package, $name )
213 my $fq_name = $package . '::' . $name;
215 $exports{$name} = $class->_make_wrapped_sub_with_meta(
223 for my $name ( @{ $args->{with_caller} } ) {
224 my $sub = $class->_sub_from_package( $package, $name )
227 my $fq_name = $package . '::' . $name;
229 $exports{$name} = $class->_make_wrapped_sub(
236 my @extra_exports = $class->_parse_trait_aliases(
237 $package, $args->{trait_aliases},
239 for my $name ( @{ $args->{as_is} }, @extra_exports ) {
240 my ( $sub, $coderef_name );
246 ( $coderef_pkg, $coderef_name )
247 = Class::MOP::get_code_info($name);
249 if ( $coderef_pkg ne $package ) {
250 $is_reexport->{$coderef_name} = 1;
254 $sub = $class->_sub_from_package( $package, $name )
257 $coderef_name = $name;
260 $export_recorder->{$sub} = 1;
262 $exports{$coderef_name} = sub {$sub};
269 sub _sub_from_package {
276 \&{ $package . '::' . $name };
279 return $sub if defined &$sub;
281 Carp::cluck "Trying to export undefined sub ${package}::${name}";
288 sub _make_wrapped_sub {
292 my $export_recorder = shift;
294 # We need to set the package at import time, so that when
295 # package Foo imports has(), we capture "Foo" as the
296 # package. This lets other packages call Foo::has() and get
297 # the right package. This is done for backwards compatibility
298 # with existing production code, not because this is a good
301 my $caller = $CALLER;
303 my $wrapper = $self->_curry_wrapper( $sub, $fq_name, $caller );
305 my $sub = subname( $fq_name => $wrapper );
307 $export_recorder->{$sub} = 1;
313 sub _make_wrapped_sub_with_meta {
317 my $export_recorder = shift;
318 my $meta_generator = shift;
321 my $caller = $CALLER;
323 my $wrapper = $self->_late_curry_wrapper(
325 $meta_generator => $caller
328 my $sub = subname( $fq_name => $wrapper );
330 $export_recorder->{$sub} = 1;
342 my $wrapper = sub { $sub->( @extra, @_ ) };
343 if ( my $proto = prototype $sub ) {
345 # XXX - Perl's prototype sucks. Use & to make set_prototype
346 # ignore the fact that we're passing "private variables"
347 &Scalar::Util::set_prototype( $wrapper, $proto );
352 sub _late_curry_wrapper {
361 # resolve curried arguments at runtime via this closure
362 my @curry = ( $extra->(@ex_args) );
363 return $sub->( @curry, @_ );
366 if ( my $proto = prototype $sub ) {
368 # XXX - Perl's prototype sucks. Use & to make set_prototype
369 # ignore the fact that we're passing "private variables"
370 &Scalar::Util::set_prototype( $wrapper, $proto );
375 sub _make_import_sub {
377 my $exporting_package = shift;
378 my $exporter = shift;
379 my $exports_from = shift;
380 my $is_reexport = shift;
381 my $meta_generator = shift;
385 # I think we could use Sub::Exporter's collector feature
386 # to do this, but that would be rather gross, since that
387 # feature isn't really designed to return a value to the
388 # caller of the exporter sub.
390 # Also, this makes sure we preserve backwards compat for
391 # _get_caller, so it always sees the arguments in the
394 ( $traits, @_ ) = _strip_traits(@_);
397 ( $metaclass, @_ ) = _strip_metaclass(@_);
399 = Moose::Util::resolve_metaclass_alias( 'Class' => $metaclass )
400 if defined $metaclass && length $metaclass;
403 ( $meta_name, @_ ) = _strip_meta_name(@_);
405 # Normally we could look at $_[0], but in some weird cases
406 # (involving goto &Moose::import), $_[0] ends as something
407 # else (like Squirrel).
408 my $class = $exporting_package;
410 $CALLER = _get_caller(@_);
412 # this works because both pragmas set $^H (see perldoc
413 # perlvar) which affects the current compilation -
414 # i.e. the file who use'd us - which is why we don't need
415 # to do anything special to make it affect that file
416 # rather than this one (which is already compiled)
422 for my $c ( grep { $_->can('init_meta') } $class, @{$exports_from} ) {
424 # init_meta can apply a role, which when loaded uses
425 # Moose::Exporter, which in turn sets $CALLER, so we need
426 # to protect against that.
427 local $CALLER = $CALLER;
429 for_class => $CALLER,
430 metaclass => $metaclass,
431 meta_name => $meta_name,
436 if ( $did_init_meta && @{$traits} ) {
438 # The traits will use Moose::Role, which in turn uses
439 # Moose::Exporter, which in turn sets $CALLER, so we need
440 # to protect against that.
441 local $CALLER = $CALLER;
442 _apply_meta_traits( $CALLER, $traits, $meta_generator );
444 elsif ( @{$traits} ) {
447 "Cannot provide traits when $class does not have an init_meta() method"
451 my ( undef, @args ) = @_;
452 my $extra = shift @args if ref $args[0] eq 'HASH';
455 if ( !$extra->{into} ) {
456 $extra->{into_level} ||= 0;
457 $extra->{into_level}++;
460 $class->$exporter( $extra, @args );
465 my $idx = first_index { ( $_ || '' ) eq '-traits' } @_;
467 return ( [], @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
469 my $traits = $_[ $idx + 1 ];
473 $traits = [$traits] unless ref $traits;
475 return ( $traits, @_ );
478 sub _strip_metaclass {
479 my $idx = first_index { ( $_ || '' ) eq '-metaclass' } @_;
481 return ( undef, @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
483 my $metaclass = $_[ $idx + 1 ];
487 return ( $metaclass, @_ );
490 sub _strip_meta_name {
491 my $idx = first_index { ( $_ || '' ) eq '-meta_name' } @_;
493 return ( 'meta', @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
495 my $meta_name = $_[ $idx + 1 ];
499 return ( $meta_name, @_ );
502 sub _apply_meta_traits {
503 my ( $class, $traits, $meta_generator ) = @_;
505 return unless @{$traits};
507 my $meta = $meta_generator->($class);
509 my $type = ( split /::/, ref $meta )[-1]
510 or Moose->throw_error(
511 'Cannot determine metaclass type for trait application . Meta isa '
514 my @resolved_traits = map {
517 : Moose::Util::resolve_metatrait_alias( $type => $_ )
520 return unless @resolved_traits;
522 my %args = ( for => $class );
524 if ( $meta->isa('Moose::Meta::Role') ) {
525 $args{role_metaroles} = { role => \@resolved_traits };
528 $args{class_metaroles} = { class => \@resolved_traits };
531 Moose::Util::MetaRole::apply_metaroles(%args);
536 # 1 extra level because it's called by import so there's a layer
541 ( ref $_[1] && defined $_[1]->{into} ) ? $_[1]->{into}
542 : ( ref $_[1] && defined $_[1]->{into_level} )
543 ? caller( $offset + $_[1]->{into_level} )
547 sub _make_unimport_sub {
549 my $exporting_package = shift;
551 my $export_recorder = shift;
552 my $is_reexport = shift;
553 my $meta_generator = shift;
556 my $caller = scalar caller();
557 Moose::Exporter->_remove_keywords(
559 [ keys %{$exports} ],
566 sub _remove_keywords {
569 my $keywords = shift;
570 my $recorded_exports = shift;
571 my $is_reexport = shift;
575 foreach my $name ( @{$keywords} ) {
576 if ( defined &{ $package . '::' . $name } ) {
577 my $sub = \&{ $package . '::' . $name };
579 # make sure it is from us
580 next unless $recorded_exports->{$sub};
582 if ( $is_reexport->{$name} ) {
585 unless _export_is_flagged(
586 \*{ join q{::} => $package, $name } );
589 # and if it is from us, then undef the slot
590 delete ${ $package . '::' }{$name};
595 sub _make_init_meta {
599 my $meta_generator = shift;
608 wrapped_method_metaclass
615 $old_style_roles{$role} = $args->{$role}
616 if exists $args->{$role};
619 my %base_class_roles;
620 %base_class_roles = ( roles => $args->{base_class_roles} )
621 if exists $args->{base_class_roles};
623 my %new_style_roles = map { $_ => $args->{$_} }
624 grep { exists $args->{$_} } qw( class_metaroles role_metaroles );
626 return unless %new_style_roles || %old_style_roles || %base_class_roles;
632 return unless $meta_generator->( $options{for_class} );
634 if ( %new_style_roles || %old_style_roles ) {
635 Moose::Util::MetaRole::apply_metaroles(
636 for => $options{for_class},
642 Moose::Util::MetaRole::apply_base_class_roles(
643 for_class => $options{for_class},
646 if $meta_generator->( $options{for_class} )
647 ->isa('Moose::Meta::Class');
649 return $meta_generator->( $options{for_class} );
660 # ABSTRACT: make an import() and unimport() just like Moose.pm
666 package MyApp::Moose;
671 Moose::Exporter->setup_import_methods(
672 with_meta => [ 'has_rw', 'sugar2' ],
673 as_is => [ 'sugar3', \&Some::Random::thing ],
678 my ( $meta, $name, %options ) = @_;
679 $meta->add_attribute(
699 This module encapsulates the exporting of sugar functions in a
700 C<Moose.pm>-like manner. It does this by building custom C<import>,
701 C<unimport>, and C<init_meta> methods for your module, based on a spec you
704 It also lets you "stack" Moose-alike modules so you can export Moose's sugar
705 as well as your own, along with sugar from any random C<MooseX> module, as
706 long as they all use C<Moose::Exporter>. This feature exists to let you bundle
707 a set of MooseX modules into a policy module that developers can use directly
708 instead of using Moose itself.
710 To simplify writing exporter modules, C<Moose::Exporter> also imports
711 C<strict> and C<warnings> into your exporter module, as well as into
716 This module provides two public methods:
720 =item B<< Moose::Exporter->setup_import_methods(...) >>
722 When you call this method, C<Moose::Exporter> builds custom C<import>,
723 C<unimport>, and C<init_meta> methods for your module. The C<import> method
724 will export the functions you specify, and can also re-export functions
725 exported by some other module (like C<Moose.pm>).
727 The C<unimport> method cleans the caller's namespace of all the exported
728 functions. This includes any functions you re-export from other
729 packages. However, if the consumer of your package also imports those
730 functions from the original package, they will I<not> be cleaned.
732 If you pass any parameters for L<Moose::Util::MetaRole>, this method will
733 generate an C<init_meta> for you as well (see below for details). This
734 C<init_meta> will call C<Moose::Util::MetaRole::apply_metaroles> and
735 C<Moose::Util::MetaRole::apply_base_class_roles> as needed.
737 Note that if any of these methods already exist, they will not be
738 overridden, you will have to use C<build_import_methods> to get the
739 coderef that would be installed.
741 This method accepts the following parameters:
745 =item * with_meta => [ ... ]
747 This list of function I<names only> will be wrapped and then exported. The
748 wrapper will pass the metaclass object for the caller as its first argument.
750 Many sugar functions will need to use this metaclass object to do something to
753 =item * as_is => [ ... ]
755 This list of function names or sub references will be exported as-is. You can
756 identify a subroutine by reference, which is handy to re-export some other
757 module's functions directly by reference (C<\&Some::Package::function>).
759 If you do export some other package's function, this function will never be
760 removed by the C<unimport> method. The reason for this is we cannot know if
761 the caller I<also> explicitly imported the sub themselves, and therefore wants
764 =item * trait_aliases => [ ... ]
766 This is a list of package names which should have shortened aliases exported,
767 similar to the functionality of L<aliased>. Each element in the list can be
768 either a package name, in which case the export will be named as the last
769 namespace component of the package, or an arrayref, whose first element is the
770 package to alias to, and second element is the alias to export.
772 =item * also => $name or \@names
774 This is a list of modules which contain functions that the caller
775 wants to export. These modules must also use C<Moose::Exporter>. The
776 most common use case will be to export the functions from C<Moose.pm>.
777 Functions specified by C<with_meta> or C<as_is> take precedence over
778 functions exported by modules specified by C<also>, so that a module
779 can selectively override functions exported by another module.
781 C<Moose::Exporter> also makes sure all these functions get removed
782 when C<unimport> is called.
786 You can also provide parameters for C<Moose::Util::MetaRole::apply_metaroles>
787 and C<Moose::Util::MetaRole::base_class_roles>. Specifically, valid parameters
788 are "class_metaroles", "role_metaroles", and "base_class_roles".
790 =item B<< Moose::Exporter->build_import_methods(...) >>
792 Returns two or three code refs, one for C<import>, one for
793 C<unimport>, and optionally one for C<init_meta>, if the appropriate
794 options are passed in.
796 Accepts the additional C<install> option, which accepts an arrayref of method
797 names to install into your exporting package. The valid options are C<import>,
798 C<unimport>, and C<init_meta>. Calling C<setup_import_methods> is equivalent
799 to calling C<build_import_methods> with C<< install => [qw(import unimport
800 init_meta)] >> except that it doesn't also return the methods.
802 The C<import> method is built using L<Sub::Exporter>. This means that it can
803 take a hashref of the form C<< { into => $package } >> to specify the package
806 Used by C<setup_import_methods>.
810 =head1 IMPORTING AND init_meta
812 If you want to set an alternative base object class or metaclass class, see
813 above for details on how this module can call L<Moose::Util::MetaRole> for
816 If you want to do something that is not supported by this module, simply
817 define an C<init_meta> method in your class. The C<import> method that
818 C<Moose::Exporter> generates for you will call this method (if it exists). It
819 will always pass the caller to this method via the C<for_class> parameter.
821 Most of the time, your C<init_meta> method will probably just call C<<
822 Moose->init_meta >> to do the real work:
825 shift; # our class name
826 return Moose->init_meta( @_, metaclass => 'My::Metaclass' );
829 Keep in mind that C<build_import_methods> will return an C<init_meta>
830 method for you, which you can also call from within your custom
833 my ( $import, $unimport, $init_meta )
834 = Moose::Exporter->build_import_methods(...);
841 # You can either pass an explicit package to import into ...
842 $class->$import( { into => scalar(caller) }, ... );
847 # ... or you can use 'goto' to provide the correct caller info to the
849 sub unimport { goto &$unimport }
856 $class->$init_meta(...);
861 =head1 METACLASS TRAITS
863 The C<import> method generated by C<Moose::Exporter> will allow the
864 user of your module to specify metaclass traits in a C<-traits>
865 parameter passed as part of the import:
867 use Moose -traits => 'My::Meta::Trait';
869 use Moose -traits => [ 'My::Meta::Trait', 'My::Other::Trait' ];
871 These traits will be applied to the caller's metaclass
872 instance. Providing traits for an exporting class that does not create
873 a metaclass for the caller is an error.
877 See L<Moose/BUGS> for details on reporting bugs.