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 [ @exports_from, $exporting_package ],
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 reverse 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 = shift;
206 for my $package ( @{$packages} ) {
207 my $args = $EXPORT_SPEC{$package}
208 or die "The $package package does not use Moose::Exporter\n";
210 for my $name ( @{ $args->{with_meta} } ) {
211 my $sub = $class->_sub_from_package( $package, $name )
214 my $fq_name = $package . '::' . $name;
216 $exports{$name} = $class->_make_wrapped_sub_with_meta(
224 for my $name ( @{ $args->{with_caller} } ) {
225 my $sub = $class->_sub_from_package( $package, $name )
228 my $fq_name = $package . '::' . $name;
230 $exports{$name} = $class->_make_wrapped_sub(
237 my @extra_exports = $class->_parse_trait_aliases(
238 $package, $args->{trait_aliases},
240 for my $name ( @{ $args->{as_is} }, @extra_exports ) {
241 my ( $sub, $coderef_name );
247 ( $coderef_pkg, $coderef_name )
248 = Class::MOP::get_code_info($name);
250 if ( $coderef_pkg ne $package ) {
251 $is_reexport->{$coderef_name} = 1;
255 $sub = $class->_sub_from_package( $package, $name )
258 $coderef_name = $name;
261 $export_recorder->{$sub} = 1;
263 $exports{$coderef_name} = sub {$sub};
270 sub _sub_from_package {
277 \&{ $package . '::' . $name };
280 return $sub if defined &$sub;
282 Carp::cluck "Trying to export undefined sub ${package}::${name}";
289 sub _make_wrapped_sub {
293 my $export_recorder = shift;
295 # We need to set the package at import time, so that when
296 # package Foo imports has(), we capture "Foo" as the
297 # package. This lets other packages call Foo::has() and get
298 # the right package. This is done for backwards compatibility
299 # with existing production code, not because this is a good
302 my $caller = $CALLER;
304 my $wrapper = $self->_curry_wrapper( $sub, $fq_name, $caller );
306 my $sub = subname( $fq_name => $wrapper );
308 $export_recorder->{$sub} = 1;
314 sub _make_wrapped_sub_with_meta {
318 my $export_recorder = shift;
319 my $meta_lookup = shift;
322 my $caller = $CALLER;
324 my $wrapper = $self->_late_curry_wrapper(
326 $meta_lookup => $caller
329 my $sub = subname( $fq_name => $wrapper );
331 $export_recorder->{$sub} = 1;
343 my $wrapper = sub { $sub->( @extra, @_ ) };
344 if ( my $proto = prototype $sub ) {
346 # XXX - Perl's prototype sucks. Use & to make set_prototype
347 # ignore the fact that we're passing "private variables"
348 &Scalar::Util::set_prototype( $wrapper, $proto );
353 sub _late_curry_wrapper {
362 # resolve curried arguments at runtime via this closure
363 my @curry = ( $extra->(@ex_args) );
364 return $sub->( @curry, @_ );
367 if ( my $proto = prototype $sub ) {
369 # XXX - Perl's prototype sucks. Use & to make set_prototype
370 # ignore the fact that we're passing "private variables"
371 &Scalar::Util::set_prototype( $wrapper, $proto );
376 sub _make_import_sub {
378 my $exporting_package = shift;
379 my $exporter = shift;
380 my $exports_from = shift;
381 my $is_reexport = shift;
382 my $meta_lookup = shift;
386 # I think we could use Sub::Exporter's collector feature
387 # to do this, but that would be rather gross, since that
388 # feature isn't really designed to return a value to the
389 # caller of the exporter sub.
391 # Also, this makes sure we preserve backwards compat for
392 # _get_caller, so it always sees the arguments in the
395 ( $traits, @_ ) = _strip_traits(@_);
398 ( $metaclass, @_ ) = _strip_metaclass(@_);
400 = Moose::Util::resolve_metaclass_alias( 'Class' => $metaclass )
401 if defined $metaclass && length $metaclass;
404 ( $meta_name, @_ ) = _strip_meta_name(@_);
406 # Normally we could look at $_[0], but in some weird cases
407 # (involving goto &Moose::import), $_[0] ends as something
408 # else (like Squirrel).
409 my $class = $exporting_package;
411 $CALLER = _get_caller(@_);
413 # this works because both pragmas set $^H (see perldoc
414 # perlvar) which affects the current compilation -
415 # i.e. the file who use'd us - which is why we don't need
416 # to do anything special to make it affect that file
417 # rather than this one (which is already compiled)
423 for my $c ( grep { $_->can('init_meta') } $class, @{$exports_from} ) {
425 # init_meta can apply a role, which when loaded uses
426 # Moose::Exporter, which in turn sets $CALLER, so we need
427 # to protect against that.
428 local $CALLER = $CALLER;
430 for_class => $CALLER,
431 metaclass => $metaclass,
432 meta_name => $meta_name,
437 if ( $did_init_meta && @{$traits} ) {
439 # The traits will use Moose::Role, which in turn uses
440 # Moose::Exporter, which in turn sets $CALLER, so we need
441 # to protect against that.
442 local $CALLER = $CALLER;
443 _apply_meta_traits( $CALLER, $traits, $meta_lookup );
445 elsif ( @{$traits} ) {
448 "Cannot provide traits when $class does not have an init_meta() method"
452 my ( undef, @args ) = @_;
453 my $extra = shift @args if ref $args[0] eq 'HASH';
456 if ( !$extra->{into} ) {
457 $extra->{into_level} ||= 0;
458 $extra->{into_level}++;
461 $class->$exporter( $extra, @args );
466 my $idx = first_index { ( $_ || '' ) eq '-traits' } @_;
468 return ( [], @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
470 my $traits = $_[ $idx + 1 ];
474 $traits = [$traits] unless ref $traits;
476 return ( $traits, @_ );
479 sub _strip_metaclass {
480 my $idx = first_index { ( $_ || '' ) eq '-metaclass' } @_;
482 return ( undef, @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
484 my $metaclass = $_[ $idx + 1 ];
488 return ( $metaclass, @_ );
491 sub _strip_meta_name {
492 my $idx = first_index { ( $_ || '' ) eq '-meta_name' } @_;
494 return ( 'meta', @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
496 my $meta_name = $_[ $idx + 1 ];
500 return ( $meta_name, @_ );
503 sub _apply_meta_traits {
504 my ( $class, $traits, $meta_lookup ) = @_;
506 return unless @{$traits};
508 my $meta = $meta_lookup->($class);
510 my $type = ( split /::/, ref $meta )[-1]
511 or Moose->throw_error(
512 'Cannot determine metaclass type for trait application . Meta isa '
515 my @resolved_traits = map {
518 : Moose::Util::resolve_metatrait_alias( $type => $_ )
521 return unless @resolved_traits;
523 my %args = ( for => $class );
525 if ( $meta->isa('Moose::Meta::Role') ) {
526 $args{role_metaroles} = { role => \@resolved_traits };
529 $args{class_metaroles} = { class => \@resolved_traits };
532 Moose::Util::MetaRole::apply_metaroles(%args);
537 # 1 extra level because it's called by import so there's a layer
542 ( ref $_[1] && defined $_[1]->{into} ) ? $_[1]->{into}
543 : ( ref $_[1] && defined $_[1]->{into_level} )
544 ? caller( $offset + $_[1]->{into_level} )
548 sub _make_unimport_sub {
550 my $exporting_package = shift;
552 my $export_recorder = shift;
553 my $is_reexport = shift;
554 my $meta_lookup = shift;
557 my $caller = scalar caller();
558 Moose::Exporter->_remove_keywords(
560 [ keys %{$exports} ],
567 sub _remove_keywords {
570 my $keywords = shift;
571 my $recorded_exports = shift;
572 my $is_reexport = shift;
576 foreach my $name ( @{$keywords} ) {
577 if ( defined &{ $package . '::' . $name } ) {
578 my $sub = \&{ $package . '::' . $name };
580 # make sure it is from us
581 next unless $recorded_exports->{$sub};
583 if ( $is_reexport->{$name} ) {
586 unless _export_is_flagged(
587 \*{ join q{::} => $package, $name } );
590 # and if it is from us, then undef the slot
591 delete ${ $package . '::' }{$name};
596 sub _make_init_meta {
600 my $meta_lookup = shift;
609 wrapped_method_metaclass
616 $old_style_roles{$role} = $args->{$role}
617 if exists $args->{$role};
620 my %base_class_roles;
621 %base_class_roles = ( roles => $args->{base_class_roles} )
622 if exists $args->{base_class_roles};
624 my %new_style_roles = map { $_ => $args->{$_} }
625 grep { exists $args->{$_} } qw( class_metaroles role_metaroles );
627 return unless %new_style_roles || %old_style_roles || %base_class_roles;
633 return unless $meta_lookup->( $options{for_class} );
635 if ( %new_style_roles || %old_style_roles ) {
636 Moose::Util::MetaRole::apply_metaroles(
637 for => $options{for_class},
643 Moose::Util::MetaRole::apply_base_class_roles(
644 for_class => $options{for_class},
647 if $meta_lookup->( $options{for_class} )
648 ->isa('Moose::Meta::Class');
650 return $meta_lookup->( $options{for_class} );
661 # ABSTRACT: make an import() and unimport() just like Moose.pm
667 package MyApp::Moose;
672 Moose::Exporter->setup_import_methods(
673 with_meta => [ 'has_rw', 'sugar2' ],
674 as_is => [ 'sugar3', \&Some::Random::thing ],
679 my ( $meta, $name, %options ) = @_;
680 $meta->add_attribute(
700 This module encapsulates the exporting of sugar functions in a
701 C<Moose.pm>-like manner. It does this by building custom C<import>,
702 C<unimport>, and C<init_meta> methods for your module, based on a spec you
705 It also lets you "stack" Moose-alike modules so you can export Moose's sugar
706 as well as your own, along with sugar from any random C<MooseX> module, as
707 long as they all use C<Moose::Exporter>. This feature exists to let you bundle
708 a set of MooseX modules into a policy module that developers can use directly
709 instead of using Moose itself.
711 To simplify writing exporter modules, C<Moose::Exporter> also imports
712 C<strict> and C<warnings> into your exporter module, as well as into
717 This module provides two public methods:
721 =item B<< Moose::Exporter->setup_import_methods(...) >>
723 When you call this method, C<Moose::Exporter> builds custom C<import>,
724 C<unimport>, and C<init_meta> methods for your module. The C<import> method
725 will export the functions you specify, and can also re-export functions
726 exported by some other module (like C<Moose.pm>).
728 The C<unimport> method cleans the caller's namespace of all the exported
729 functions. This includes any functions you re-export from other
730 packages. However, if the consumer of your package also imports those
731 functions from the original package, they will I<not> be cleaned.
733 If you pass any parameters for L<Moose::Util::MetaRole>, this method will
734 generate an C<init_meta> for you as well (see below for details). This
735 C<init_meta> will call C<Moose::Util::MetaRole::apply_metaroles> and
736 C<Moose::Util::MetaRole::apply_base_class_roles> as needed.
738 Note that if any of these methods already exist, they will not be
739 overridden, you will have to use C<build_import_methods> to get the
740 coderef that would be installed.
742 This method accepts the following parameters:
746 =item * with_meta => [ ... ]
748 This list of function I<names only> will be wrapped and then exported. The
749 wrapper will pass the metaclass object for the caller as its first argument.
751 Many sugar functions will need to use this metaclass object to do something to
754 =item * as_is => [ ... ]
756 This list of function names or sub references will be exported as-is. You can
757 identify a subroutine by reference, which is handy to re-export some other
758 module's functions directly by reference (C<\&Some::Package::function>).
760 If you do export some other package's function, this function will never be
761 removed by the C<unimport> method. The reason for this is we cannot know if
762 the caller I<also> explicitly imported the sub themselves, and therefore wants
765 =item * trait_aliases => [ ... ]
767 This is a list of package names which should have shortened aliases exported,
768 similar to the functionality of L<aliased>. Each element in the list can be
769 either a package name, in which case the export will be named as the last
770 namespace component of the package, or an arrayref, whose first element is the
771 package to alias to, and second element is the alias to export.
773 =item * also => $name or \@names
775 This is a list of modules which contain functions that the caller
776 wants to export. These modules must also use C<Moose::Exporter>. The
777 most common use case will be to export the functions from C<Moose.pm>.
778 Functions specified by C<with_meta> or C<as_is> take precedence over
779 functions exported by modules specified by C<also>, so that a module
780 can selectively override functions exported by another module.
782 C<Moose::Exporter> also makes sure all these functions get removed
783 when C<unimport> is called.
785 =item * meta_lookup => sub { ... }
787 This is a function which will be called to provide the metaclass
788 to be operated upon by the exporter. This is an advanced feature
789 intended for use by package generator modules in the vein of
790 L<MooseX::Role::Parameterized> in order to simplify reusing sugar
791 from other modules that use C<Moose::Exporter>. This function is
792 used, for example, to select the metaclass to bind to functions
793 that are exported using the C<with_meta> option.
795 This function will receive one parameter: the class name into which
796 the sugar is being exported. The default implementation is:
798 sub { Class::MOP::class_of(shift) }
800 Accordingly, this function is expected to return a metaclass.
804 You can also provide parameters for C<Moose::Util::MetaRole::apply_metaroles>
805 and C<Moose::Util::MetaRole::base_class_roles>. Specifically, valid parameters
806 are "class_metaroles", "role_metaroles", and "base_class_roles".
808 =item B<< Moose::Exporter->build_import_methods(...) >>
810 Returns two or three code refs, one for C<import>, one for
811 C<unimport>, and optionally one for C<init_meta>, if the appropriate
812 options are passed in.
814 Accepts the additional C<install> option, which accepts an arrayref of method
815 names to install into your exporting package. The valid options are C<import>,
816 C<unimport>, and C<init_meta>. Calling C<setup_import_methods> is equivalent
817 to calling C<build_import_methods> with C<< install => [qw(import unimport
818 init_meta)] >> except that it doesn't also return the methods.
820 The C<import> method is built using L<Sub::Exporter>. This means that it can
821 take a hashref of the form C<< { into => $package } >> to specify the package
824 Used by C<setup_import_methods>.
828 =head1 IMPORTING AND init_meta
830 If you want to set an alternative base object class or metaclass class, see
831 above for details on how this module can call L<Moose::Util::MetaRole> for
834 If you want to do something that is not supported by this module, simply
835 define an C<init_meta> method in your class. The C<import> method that
836 C<Moose::Exporter> generates for you will call this method (if it exists). It
837 will always pass the caller to this method via the C<for_class> parameter.
839 Most of the time, your C<init_meta> method will probably just call C<<
840 Moose->init_meta >> to do the real work:
843 shift; # our class name
844 return Moose->init_meta( @_, metaclass => 'My::Metaclass' );
847 Keep in mind that C<build_import_methods> will return an C<init_meta>
848 method for you, which you can also call from within your custom
851 my ( $import, $unimport, $init_meta )
852 = Moose::Exporter->build_import_methods(...);
859 # You can either pass an explicit package to import into ...
860 $class->$import( { into => scalar(caller) }, ... );
865 # ... or you can use 'goto' to provide the correct caller info to the
867 sub unimport { goto &$unimport }
874 $class->$init_meta(...);
879 =head1 METACLASS TRAITS
881 The C<import> method generated by C<Moose::Exporter> will allow the
882 user of your module to specify metaclass traits in a C<-traits>
883 parameter passed as part of the import:
885 use Moose -traits => 'My::Meta::Trait';
887 use Moose -traits => [ 'My::Meta::Trait', 'My::Other::Trait' ];
889 These traits will be applied to the caller's metaclass
890 instance. Providing traits for an exporting class that does not create
891 a metaclass for the caller is an error.
895 See L<Moose/BUGS> for details on reporting bugs.