1 package Moose::Exporter;
6 use Class::Load qw(is_class_loaded);
8 use List::MoreUtils qw( first_index uniq );
9 use Moose::Util::MetaRole;
10 use Scalar::Util qw(reftype);
11 use Sub::Exporter 0.980;
12 use Sub::Name qw(subname);
16 sub setup_import_methods {
17 my ( $class, %args ) = @_;
19 $args{exporting_package} ||= caller();
21 $class->build_import_methods(
23 install => [qw(import unimport init_meta)]
27 sub build_import_methods {
28 my ( $class, %args ) = @_;
30 my $exporting_package = $args{exporting_package} ||= caller();
32 my $meta_lookup = $args{meta_lookup} || sub { Class::MOP::class_of(shift) };
34 $EXPORT_SPEC{$exporting_package} = \%args;
36 my @exports_from = $class->_follow_also($exporting_package);
38 my $export_recorder = {};
41 my $exports = $class->_make_sub_exporter_params(
42 [ $exporting_package, @exports_from ],
45 $args{meta_lookup}, # so that we don't pass through the default
48 my $exporter = $class->_make_exporter(
55 $methods{import} = $class->_make_import_sub(
63 $methods{unimport} = $class->_make_unimport_sub(
71 $methods{init_meta} = $class->_make_init_meta(
77 my $package = Class::MOP::Package->initialize($exporting_package);
78 for my $to_install ( @{ $args{install} || [] } ) {
79 my $symbol = '&' . $to_install;
81 unless $methods{$to_install}
82 && !$package->has_package_symbol($symbol);
83 $package->add_package_symbol( $symbol, $methods{$to_install} );
86 return ( $methods{import}, $methods{unimport}, $methods{init_meta} );
90 my ($class, $exports, $is_reexport, $meta_lookup) = @_;
92 return Sub::Exporter::build_exporter(
95 groups => { default => [':all'] },
97 my ($arg, $to_export) = @_;
98 my $meta = $meta_lookup->($arg->{into});
100 goto &Sub::Exporter::default_installer unless $meta;
102 # don't overwrite existing symbols with our magically flagged
103 # version of it if we would install the same sub that's already
106 my @filtered_to_export;
108 for (my $i = 0; $i < @{ $to_export }; $i += 2) {
109 my ($as, $cv) = @{ $to_export }[$i, $i + 1];
112 && $meta->has_package_symbol('&' . $as)
113 && $meta->get_package_symbol('&' . $as) == $cv;
115 push @filtered_to_export, $as, $cv;
116 $installed{$as} = 1 unless ref $as;
119 Sub::Exporter::default_installer($arg, \@filtered_to_export);
121 for my $name ( keys %{$is_reexport} ) {
124 next unless exists $installed{$name};
125 _flag_as_reexport( \*{ join q{::}, $arg->{into}, $name } );
137 my $exporting_package = shift;
139 local %$seen = ( $exporting_package => 1 );
141 return uniq( _follow_also_real($exporting_package) );
144 sub _follow_also_real {
145 my $exporting_package = shift;
147 if ( !exists $EXPORT_SPEC{$exporting_package} ) {
148 my $loaded = is_class_loaded($exporting_package);
150 die "Package in also ($exporting_package) does not seem to "
151 . "use Moose::Exporter"
152 . ( $loaded ? "" : " (is it loaded?)" );
155 my $also = $EXPORT_SPEC{$exporting_package}{also};
157 return unless defined $also;
159 my @also = ref $also ? @{$also} : $also;
161 for my $package (@also) {
163 "Circular reference in 'also' parameter to Moose::Exporter between $exporting_package and $package"
164 if $seen->{$package};
166 $seen->{$package} = 1;
169 return @also, map { _follow_also_real($_) } @also;
173 sub _parse_trait_aliases {
175 my ($package, $aliases) = @_;
178 for my $alias (@$aliases) {
181 reftype($alias) eq 'ARRAY'
182 or Moose->throw_error(reftype($alias) . " references are not "
183 . "valid arguments to the 'trait_aliases' "
186 ($alias, $name) = @$alias;
189 ($name = $alias) =~ s/.*:://;
191 push @ret, subname "${package}::${name}" => sub () { $alias };
197 sub _make_sub_exporter_params {
199 my $packages = shift;
200 my $export_recorder = shift;
201 my $is_reexport = shift;
202 my $meta_lookup_override = shift;
205 my $current_meta_lookup;
207 for my $package ( @{$packages} ) {
208 my $args = $EXPORT_SPEC{$package}
209 or die "The $package package does not use Moose::Exporter\n";
211 $current_meta_lookup = $meta_lookup_override || $args->{meta_lookup};
212 $meta_lookup_override = $current_meta_lookup;
214 my $meta_lookup = $current_meta_lookup
215 || sub { Class::MOP::class_of(shift) };
217 for my $name ( @{ $args->{with_meta} } ) {
218 my $sub = $class->_sub_from_package( $package, $name )
221 my $fq_name = $package . '::' . $name;
223 $exports{$name} = $class->_make_wrapped_sub_with_meta(
228 ) unless exists $exports{$name};
231 for my $name ( @{ $args->{with_caller} } ) {
232 my $sub = $class->_sub_from_package( $package, $name )
235 my $fq_name = $package . '::' . $name;
237 $exports{$name} = $class->_make_wrapped_sub(
241 ) unless exists $exports{$name};
244 my @extra_exports = $class->_parse_trait_aliases(
245 $package, $args->{trait_aliases},
247 for my $name ( @{ $args->{as_is} }, @extra_exports ) {
248 my ( $sub, $coderef_name );
254 ( $coderef_pkg, $coderef_name )
255 = Class::MOP::get_code_info($name);
257 if ( $coderef_pkg ne $package ) {
258 $is_reexport->{$coderef_name} = 1;
262 $sub = $class->_sub_from_package( $package, $name )
265 $coderef_name = $name;
268 $export_recorder->{$sub} = 1;
270 $exports{$coderef_name} = sub { $sub }
271 unless exists $exports{$coderef_name};
278 sub _sub_from_package {
285 \&{ $package . '::' . $name };
288 return $sub if defined &$sub;
290 Carp::cluck "Trying to export undefined sub ${package}::${name}";
297 sub _make_wrapped_sub {
301 my $export_recorder = shift;
303 # We need to set the package at import time, so that when
304 # package Foo imports has(), we capture "Foo" as the
305 # package. This lets other packages call Foo::has() and get
306 # the right package. This is done for backwards compatibility
307 # with existing production code, not because this is a good
310 my $caller = $CALLER;
312 my $wrapper = $self->_curry_wrapper( $sub, $fq_name, $caller );
314 my $sub = subname( $fq_name => $wrapper );
316 $export_recorder->{$sub} = 1;
322 sub _make_wrapped_sub_with_meta {
326 my $export_recorder = shift;
327 my $meta_lookup = shift;
330 my $caller = $CALLER;
332 my $wrapper = $self->_late_curry_wrapper(
334 $meta_lookup => $caller
337 my $sub = subname( $fq_name => $wrapper );
339 $export_recorder->{$sub} = 1;
351 my $wrapper = sub { $sub->( @extra, @_ ) };
352 if ( my $proto = prototype $sub ) {
354 # XXX - Perl's prototype sucks. Use & to make set_prototype
355 # ignore the fact that we're passing "private variables"
356 &Scalar::Util::set_prototype( $wrapper, $proto );
361 sub _late_curry_wrapper {
370 # resolve curried arguments at runtime via this closure
371 my @curry = ( $extra->(@ex_args) );
372 return $sub->( @curry, @_ );
375 if ( my $proto = prototype $sub ) {
377 # XXX - Perl's prototype sucks. Use & to make set_prototype
378 # ignore the fact that we're passing "private variables"
379 &Scalar::Util::set_prototype( $wrapper, $proto );
384 sub _make_import_sub {
386 my $exporting_package = shift;
387 my $exporter = shift;
388 my $exports_from = shift;
389 my $is_reexport = shift;
390 my $meta_lookup = shift;
394 # I think we could use Sub::Exporter's collector feature
395 # to do this, but that would be rather gross, since that
396 # feature isn't really designed to return a value to the
397 # caller of the exporter sub.
399 # Also, this makes sure we preserve backwards compat for
400 # _get_caller, so it always sees the arguments in the
403 ( $traits, @_ ) = _strip_traits(@_);
406 ( $metaclass, @_ ) = _strip_metaclass(@_);
408 = Moose::Util::resolve_metaclass_alias( 'Class' => $metaclass )
409 if defined $metaclass && length $metaclass;
412 ( $meta_name, @_ ) = _strip_meta_name(@_);
414 # Normally we could look at $_[0], but in some weird cases
415 # (involving goto &Moose::import), $_[0] ends as something
416 # else (like Squirrel).
417 my $class = $exporting_package;
419 $CALLER = _get_caller(@_);
421 # this works because both pragmas set $^H (see perldoc
422 # perlvar) which affects the current compilation -
423 # i.e. the file who use'd us - which is why we don't need
424 # to do anything special to make it affect that file
425 # rather than this one (which is already compiled)
431 for my $c ( grep { $_->can('init_meta') } $class, @{$exports_from} ) {
433 # init_meta can apply a role, which when loaded uses
434 # Moose::Exporter, which in turn sets $CALLER, so we need
435 # to protect against that.
436 local $CALLER = $CALLER;
438 for_class => $CALLER,
439 metaclass => $metaclass,
440 meta_name => $meta_name,
445 if ( $did_init_meta && @{$traits} ) {
447 # The traits will use Moose::Role, which in turn uses
448 # Moose::Exporter, which in turn sets $CALLER, so we need
449 # to protect against that.
450 local $CALLER = $CALLER;
451 _apply_meta_traits( $CALLER, $traits, $meta_lookup );
453 elsif ( @{$traits} ) {
456 "Cannot provide traits when $class does not have an init_meta() method"
460 my ( undef, @args ) = @_;
461 my $extra = shift @args if ref $args[0] eq 'HASH';
464 if ( !$extra->{into} ) {
465 $extra->{into_level} ||= 0;
466 $extra->{into_level}++;
469 $class->$exporter( $extra, @args );
474 my $idx = first_index { ( $_ || '' ) eq '-traits' } @_;
476 return ( [], @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
478 my $traits = $_[ $idx + 1 ];
482 $traits = [$traits] unless ref $traits;
484 return ( $traits, @_ );
487 sub _strip_metaclass {
488 my $idx = first_index { ( $_ || '' ) eq '-metaclass' } @_;
490 return ( undef, @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
492 my $metaclass = $_[ $idx + 1 ];
496 return ( $metaclass, @_ );
499 sub _strip_meta_name {
500 my $idx = first_index { ( $_ || '' ) eq '-meta_name' } @_;
502 return ( 'meta', @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
504 my $meta_name = $_[ $idx + 1 ];
508 return ( $meta_name, @_ );
511 sub _apply_meta_traits {
512 my ( $class, $traits, $meta_lookup ) = @_;
514 return unless @{$traits};
516 my $meta = $meta_lookup->($class);
518 my $type = ( split /::/, ref $meta )[-1]
519 or Moose->throw_error(
520 'Cannot determine metaclass type for trait application . Meta isa '
523 my @resolved_traits = map {
526 : Moose::Util::resolve_metatrait_alias( $type => $_ )
529 return unless @resolved_traits;
531 my %args = ( for => $class );
533 if ( $meta->isa('Moose::Meta::Role') ) {
534 $args{role_metaroles} = { role => \@resolved_traits };
537 $args{class_metaroles} = { class => \@resolved_traits };
540 Moose::Util::MetaRole::apply_metaroles(%args);
545 # 1 extra level because it's called by import so there's a layer
550 ( ref $_[1] && defined $_[1]->{into} ) ? $_[1]->{into}
551 : ( ref $_[1] && defined $_[1]->{into_level} )
552 ? caller( $offset + $_[1]->{into_level} )
556 sub _make_unimport_sub {
558 my $exporting_package = shift;
560 my $export_recorder = shift;
561 my $is_reexport = shift;
562 my $meta_lookup = shift;
565 my $caller = scalar caller();
566 Moose::Exporter->_remove_keywords(
568 [ keys %{$exports} ],
575 sub _remove_keywords {
578 my $keywords = shift;
579 my $recorded_exports = shift;
580 my $is_reexport = shift;
584 foreach my $name ( @{$keywords} ) {
585 if ( defined &{ $package . '::' . $name } ) {
586 my $sub = \&{ $package . '::' . $name };
588 # make sure it is from us
589 next unless $recorded_exports->{$sub};
591 if ( $is_reexport->{$name} ) {
594 unless _export_is_flagged(
595 \*{ join q{::} => $package, $name } );
598 # and if it is from us, then undef the slot
599 delete ${ $package . '::' }{$name};
604 sub _make_init_meta {
608 my $meta_lookup = shift;
617 wrapped_method_metaclass
624 $old_style_roles{$role} = $args->{$role}
625 if exists $args->{$role};
628 my %base_class_roles;
629 %base_class_roles = ( roles => $args->{base_class_roles} )
630 if exists $args->{base_class_roles};
632 my %new_style_roles = map { $_ => $args->{$_} }
633 grep { exists $args->{$_} } qw( class_metaroles role_metaroles );
635 return unless %new_style_roles || %old_style_roles || %base_class_roles;
641 return unless $meta_lookup->( $options{for_class} );
643 if ( %new_style_roles || %old_style_roles ) {
644 Moose::Util::MetaRole::apply_metaroles(
645 for => $options{for_class},
651 Moose::Util::MetaRole::apply_base_class_roles(
652 for_class => $options{for_class},
655 if $meta_lookup->( $options{for_class} )
656 ->isa('Moose::Meta::Class');
658 return $meta_lookup->( $options{for_class} );
669 # ABSTRACT: make an import() and unimport() just like Moose.pm
675 package MyApp::Moose;
680 Moose::Exporter->setup_import_methods(
681 with_meta => [ 'has_rw', 'sugar2' ],
682 as_is => [ 'sugar3', \&Some::Random::thing ],
687 my ( $meta, $name, %options ) = @_;
688 $meta->add_attribute(
708 This module encapsulates the exporting of sugar functions in a
709 C<Moose.pm>-like manner. It does this by building custom C<import>,
710 C<unimport>, and C<init_meta> methods for your module, based on a spec you
713 It also lets you "stack" Moose-alike modules so you can export Moose's sugar
714 as well as your own, along with sugar from any random C<MooseX> module, as
715 long as they all use C<Moose::Exporter>. This feature exists to let you bundle
716 a set of MooseX modules into a policy module that developers can use directly
717 instead of using Moose itself.
719 To simplify writing exporter modules, C<Moose::Exporter> also imports
720 C<strict> and C<warnings> into your exporter module, as well as into
725 This module provides two public methods:
729 =item B<< Moose::Exporter->setup_import_methods(...) >>
731 When you call this method, C<Moose::Exporter> builds custom C<import>,
732 C<unimport>, and C<init_meta> methods for your module. The C<import> method
733 will export the functions you specify, and can also re-export functions
734 exported by some other module (like C<Moose.pm>).
736 The C<unimport> method cleans the caller's namespace of all the exported
737 functions. This includes any functions you re-export from other
738 packages. However, if the consumer of your package also imports those
739 functions from the original package, they will I<not> be cleaned.
741 If you pass any parameters for L<Moose::Util::MetaRole>, this method will
742 generate an C<init_meta> for you as well (see below for details). This
743 C<init_meta> will call C<Moose::Util::MetaRole::apply_metaroles> and
744 C<Moose::Util::MetaRole::apply_base_class_roles> as needed.
746 Note that if any of these methods already exist, they will not be
747 overridden, you will have to use C<build_import_methods> to get the
748 coderef that would be installed.
750 This method accepts the following parameters:
754 =item * with_meta => [ ... ]
756 This list of function I<names only> will be wrapped and then exported. The
757 wrapper will pass the metaclass object for the caller as its first argument.
759 Many sugar functions will need to use this metaclass object to do something to
762 =item * as_is => [ ... ]
764 This list of function names or sub references will be exported as-is. You can
765 identify a subroutine by reference, which is handy to re-export some other
766 module's functions directly by reference (C<\&Some::Package::function>).
768 If you do export some other package's function, this function will never be
769 removed by the C<unimport> method. The reason for this is we cannot know if
770 the caller I<also> explicitly imported the sub themselves, and therefore wants
773 =item * trait_aliases => [ ... ]
775 This is a list of package names which should have shortened aliases exported,
776 similar to the functionality of L<aliased>. Each element in the list can be
777 either a package name, in which case the export will be named as the last
778 namespace component of the package, or an arrayref, whose first element is the
779 package to alias to, and second element is the alias to export.
781 =item * also => $name or \@names
783 This is a list of modules which contain functions that the caller
784 wants to export. These modules must also use C<Moose::Exporter>. The
785 most common use case will be to export the functions from C<Moose.pm>.
786 Functions specified by C<with_meta> or C<as_is> take precedence over
787 functions exported by modules specified by C<also>, so that a module
788 can selectively override functions exported by another module.
790 C<Moose::Exporter> also makes sure all these functions get removed
791 when C<unimport> is called.
793 =item * meta_lookup => sub { ... }
795 This is a function which will be called to provide the metaclass
796 to be operated upon by the exporter. This is an advanced feature
797 intended for use by package generator modules in the vein of
798 L<MooseX::Role::Parameterized> in order to simplify reusing sugar
799 from other modules that use C<Moose::Exporter>. This function is
800 used, for example, to select the metaclass to bind to functions
801 that are exported using the C<with_meta> option.
803 This function will receive one parameter: the class name into which
804 the sugar is being exported. The default implementation is:
806 sub { Class::MOP::class_of(shift) }
808 Accordingly, this function is expected to return a metaclass.
812 You can also provide parameters for C<Moose::Util::MetaRole::apply_metaroles>
813 and C<Moose::Util::MetaRole::base_class_roles>. Specifically, valid parameters
814 are "class_metaroles", "role_metaroles", and "base_class_roles".
816 =item B<< Moose::Exporter->build_import_methods(...) >>
818 Returns two or three code refs, one for C<import>, one for
819 C<unimport>, and optionally one for C<init_meta>, if the appropriate
820 options are passed in.
822 Accepts the additional C<install> option, which accepts an arrayref of method
823 names to install into your exporting package. The valid options are C<import>,
824 C<unimport>, and C<init_meta>. Calling C<setup_import_methods> is equivalent
825 to calling C<build_import_methods> with C<< install => [qw(import unimport
826 init_meta)] >> except that it doesn't also return the methods.
828 The C<import> method is built using L<Sub::Exporter>. This means that it can
829 take a hashref of the form C<< { into => $package } >> to specify the package
832 Used by C<setup_import_methods>.
836 =head1 IMPORTING AND init_meta
838 If you want to set an alternative base object class or metaclass class, see
839 above for details on how this module can call L<Moose::Util::MetaRole> for
842 If you want to do something that is not supported by this module, simply
843 define an C<init_meta> method in your class. The C<import> method that
844 C<Moose::Exporter> generates for you will call this method (if it exists). It
845 will always pass the caller to this method via the C<for_class> parameter.
847 Most of the time, your C<init_meta> method will probably just call C<<
848 Moose->init_meta >> to do the real work:
851 shift; # our class name
852 return Moose->init_meta( @_, metaclass => 'My::Metaclass' );
855 Keep in mind that C<build_import_methods> will return an C<init_meta>
856 method for you, which you can also call from within your custom
859 my ( $import, $unimport, $init_meta )
860 = Moose::Exporter->build_import_methods(...);
867 # You can either pass an explicit package to import into ...
868 $class->$import( { into => scalar(caller) }, ... );
873 # ... or you can use 'goto' to provide the correct caller info to the
875 sub unimport { goto &$unimport }
882 $class->$init_meta(...);
887 =head1 METACLASS TRAITS
889 The C<import> method generated by C<Moose::Exporter> will allow the
890 user of your module to specify metaclass traits in a C<-traits>
891 parameter passed as part of the import:
893 use Moose -traits => 'My::Meta::Trait';
895 use Moose -traits => [ 'My::Meta::Trait', 'My::Other::Trait' ];
897 These traits will be applied to the caller's metaclass
898 instance. Providing traits for an exporting class that does not create
899 a metaclass for the caller is an error.
903 See L<Moose/BUGS> for details on reporting bugs.