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 # A reminder to intreped Moose hackers
28 # there may be more than one level of exporter
29 # don't make doy cry. -- perigrin
31 sub build_import_methods {
32 my ( $class, %args ) = @_;
34 my $exporting_package = $args{exporting_package} ||= caller();
36 my $meta_lookup = $args{meta_lookup} || sub { Class::MOP::class_of(shift) };
38 $EXPORT_SPEC{$exporting_package} = \%args;
40 my @exports_from = $class->_follow_also($exporting_package);
42 my $export_recorder = {};
45 my $exports = $class->_make_sub_exporter_params(
46 [ $exporting_package, @exports_from ],
49 $args{meta_lookup}, # so that we don't pass through the default
52 my $exporter = $class->_make_exporter(
59 $methods{import} = $class->_make_import_sub(
67 $methods{unimport} = $class->_make_unimport_sub(
75 $methods{init_meta} = $class->_make_init_meta(
81 my $package = Class::MOP::Package->initialize($exporting_package);
82 for my $to_install ( @{ $args{install} || [] } ) {
83 my $symbol = '&' . $to_install;
85 unless $methods{$to_install}
86 && !$package->has_package_symbol($symbol);
87 $package->add_package_symbol( $symbol, $methods{$to_install} );
90 return ( $methods{import}, $methods{unimport}, $methods{init_meta} );
94 my ($class, $exports, $is_reexport, $meta_lookup) = @_;
96 return Sub::Exporter::build_exporter(
99 groups => { default => [':all'] },
101 my ($arg, $to_export) = @_;
102 my $meta = $meta_lookup->($arg->{into});
104 goto &Sub::Exporter::default_installer unless $meta;
106 # don't overwrite existing symbols with our magically flagged
107 # version of it if we would install the same sub that's already
110 my @filtered_to_export;
112 for (my $i = 0; $i < @{ $to_export }; $i += 2) {
113 my ($as, $cv) = @{ $to_export }[$i, $i + 1];
116 && $meta->has_package_symbol('&' . $as)
117 && $meta->get_package_symbol('&' . $as) == $cv;
119 push @filtered_to_export, $as, $cv;
120 $installed{$as} = 1 unless ref $as;
123 Sub::Exporter::default_installer($arg, \@filtered_to_export);
125 for my $name ( keys %{$is_reexport} ) {
128 next unless exists $installed{$name};
129 _flag_as_reexport( \*{ join q{::}, $arg->{into}, $name } );
141 my $exporting_package = shift;
143 local %$seen = ( $exporting_package => 1 );
145 return uniq( _follow_also_real($exporting_package) );
148 sub _follow_also_real {
149 my $exporting_package = shift;
151 if ( !exists $EXPORT_SPEC{$exporting_package} ) {
152 my $loaded = is_class_loaded($exporting_package);
154 die "Package in also ($exporting_package) does not seem to "
155 . "use Moose::Exporter"
156 . ( $loaded ? "" : " (is it loaded?)" );
159 my $also = $EXPORT_SPEC{$exporting_package}{also};
161 return unless defined $also;
163 my @also = ref $also ? @{$also} : $also;
165 for my $package (@also) {
167 "Circular reference in 'also' parameter to Moose::Exporter between $exporting_package and $package"
168 if $seen->{$package};
170 $seen->{$package} = 1;
173 return @also, map { _follow_also_real($_) } @also;
177 sub _parse_trait_aliases {
179 my ($package, $aliases) = @_;
182 for my $alias (@$aliases) {
185 reftype($alias) eq 'ARRAY'
186 or Moose->throw_error(reftype($alias) . " references are not "
187 . "valid arguments to the 'trait_aliases' "
190 ($alias, $name) = @$alias;
193 ($name = $alias) =~ s/.*:://;
195 push @ret, subname "${package}::${name}" => sub () { $alias };
201 sub _make_sub_exporter_params {
203 my $packages = shift;
204 my $export_recorder = shift;
205 my $is_reexport = shift;
206 my $meta_lookup_override = shift;
209 my $current_meta_lookup;
211 for my $package ( @{$packages} ) {
212 my $args = $EXPORT_SPEC{$package}
213 or die "The $package package does not use Moose::Exporter\n";
215 $current_meta_lookup = $meta_lookup_override || $args->{meta_lookup};
216 $meta_lookup_override = $current_meta_lookup;
218 my $meta_lookup = $current_meta_lookup
219 || sub { Class::MOP::class_of(shift) };
221 for my $name ( @{ $args->{with_meta} } ) {
222 my $sub = $class->_sub_from_package( $package, $name )
225 my $fq_name = $package . '::' . $name;
227 $exports{$name} = $class->_make_wrapped_sub_with_meta(
232 ) unless exists $exports{$name};
235 for my $name ( @{ $args->{with_caller} } ) {
236 my $sub = $class->_sub_from_package( $package, $name )
239 my $fq_name = $package . '::' . $name;
241 $exports{$name} = $class->_make_wrapped_sub(
245 ) unless exists $exports{$name};
248 my @extra_exports = $class->_parse_trait_aliases(
249 $package, $args->{trait_aliases},
251 for my $name ( @{ $args->{as_is} }, @extra_exports ) {
252 my ( $sub, $coderef_name );
258 ( $coderef_pkg, $coderef_name )
259 = Class::MOP::get_code_info($name);
261 if ( $coderef_pkg ne $package ) {
262 $is_reexport->{$coderef_name} = 1;
266 $sub = $class->_sub_from_package( $package, $name )
269 $coderef_name = $name;
272 $export_recorder->{$sub} = 1;
274 $exports{$coderef_name} = sub { $sub }
275 unless exists $exports{$coderef_name};
282 sub _sub_from_package {
289 \&{ $package . '::' . $name };
292 return $sub if defined &$sub;
294 Carp::cluck "Trying to export undefined sub ${package}::${name}";
301 sub _make_wrapped_sub {
305 my $export_recorder = shift;
307 # We need to set the package at import time, so that when
308 # package Foo imports has(), we capture "Foo" as the
309 # package. This lets other packages call Foo::has() and get
310 # the right package. This is done for backwards compatibility
311 # with existing production code, not because this is a good
314 my $caller = $CALLER;
316 my $wrapper = $self->_curry_wrapper( $sub, $fq_name, $caller );
318 my $sub = subname( $fq_name => $wrapper );
320 $export_recorder->{$sub} = 1;
326 sub _make_wrapped_sub_with_meta {
330 my $export_recorder = shift;
331 my $meta_lookup = shift;
334 my $caller = $CALLER;
336 my $wrapper = $self->_late_curry_wrapper(
338 $meta_lookup => $caller
341 my $sub = subname( $fq_name => $wrapper );
343 $export_recorder->{$sub} = 1;
355 my $wrapper = sub { $sub->( @extra, @_ ) };
356 if ( my $proto = prototype $sub ) {
358 # XXX - Perl's prototype sucks. Use & to make set_prototype
359 # ignore the fact that we're passing "private variables"
360 &Scalar::Util::set_prototype( $wrapper, $proto );
365 sub _late_curry_wrapper {
374 # resolve curried arguments at runtime via this closure
375 my @curry = ( $extra->(@ex_args) );
376 return $sub->( @curry, @_ );
379 if ( my $proto = prototype $sub ) {
381 # XXX - Perl's prototype sucks. Use & to make set_prototype
382 # ignore the fact that we're passing "private variables"
383 &Scalar::Util::set_prototype( $wrapper, $proto );
388 sub _make_import_sub {
390 my $exporting_package = shift;
391 my $exporter = shift;
392 my $exports_from = shift;
393 my $is_reexport = shift;
394 my $meta_lookup = shift;
398 # I think we could use Sub::Exporter's collector feature
399 # to do this, but that would be rather gross, since that
400 # feature isn't really designed to return a value to the
401 # caller of the exporter sub.
403 # Also, this makes sure we preserve backwards compat for
404 # _get_caller, so it always sees the arguments in the
407 ( $traits, @_ ) = _strip_traits(@_);
410 ( $metaclass, @_ ) = _strip_metaclass(@_);
412 = Moose::Util::resolve_metaclass_alias( 'Class' => $metaclass )
413 if defined $metaclass && length $metaclass;
416 ( $meta_name, @_ ) = _strip_meta_name(@_);
418 # Normally we could look at $_[0], but in some weird cases
419 # (involving goto &Moose::import), $_[0] ends as something
420 # else (like Squirrel).
421 my $class = $exporting_package;
423 $CALLER = _get_caller(@_);
425 # this works because both pragmas set $^H (see perldoc
426 # perlvar) which affects the current compilation -
427 # i.e. the file who use'd us - which is why we don't need
428 # to do anything special to make it affect that file
429 # rather than this one (which is already compiled)
435 for my $c ( grep { $_->can('init_meta') } $class, @{$exports_from} ) {
437 # init_meta can apply a role, which when loaded uses
438 # Moose::Exporter, which in turn sets $CALLER, so we need
439 # to protect against that.
440 local $CALLER = $CALLER;
442 for_class => $CALLER,
443 metaclass => $metaclass,
444 meta_name => $meta_name,
449 if ( $did_init_meta && @{$traits} ) {
451 # The traits will use Moose::Role, which in turn uses
452 # Moose::Exporter, which in turn sets $CALLER, so we need
453 # to protect against that.
454 local $CALLER = $CALLER;
455 _apply_meta_traits( $CALLER, $traits, $meta_lookup );
457 elsif ( @{$traits} ) {
460 "Cannot provide traits when $class does not have an init_meta() method"
464 my ( undef, @args ) = @_;
465 my $extra = shift @args if ref $args[0] eq 'HASH';
468 if ( !$extra->{into} ) {
469 $extra->{into_level} ||= 0;
470 $extra->{into_level}++;
473 $class->$exporter( $extra, @args );
478 my $idx = first_index { ( $_ || '' ) eq '-traits' } @_;
480 return ( [], @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
482 my $traits = $_[ $idx + 1 ];
486 $traits = [$traits] unless ref $traits;
488 return ( $traits, @_ );
491 sub _strip_metaclass {
492 my $idx = first_index { ( $_ || '' ) eq '-metaclass' } @_;
494 return ( undef, @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
496 my $metaclass = $_[ $idx + 1 ];
500 return ( $metaclass, @_ );
503 sub _strip_meta_name {
504 my $idx = first_index { ( $_ || '' ) eq '-meta_name' } @_;
506 return ( 'meta', @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
508 my $meta_name = $_[ $idx + 1 ];
512 return ( $meta_name, @_ );
515 sub _apply_meta_traits {
516 my ( $class, $traits, $meta_lookup ) = @_;
518 return unless @{$traits};
520 my $meta = $meta_lookup->($class);
522 my $type = ( split /::/, ref $meta )[-1]
523 or Moose->throw_error(
524 'Cannot determine metaclass type for trait application . Meta isa '
527 my @resolved_traits = map {
530 : Moose::Util::resolve_metatrait_alias( $type => $_ )
533 return unless @resolved_traits;
535 my %args = ( for => $class );
537 if ( $meta->isa('Moose::Meta::Role') ) {
538 $args{role_metaroles} = { role => \@resolved_traits };
541 $args{class_metaroles} = { class => \@resolved_traits };
544 Moose::Util::MetaRole::apply_metaroles(%args);
549 # 1 extra level because it's called by import so there's a layer
554 ( ref $_[1] && defined $_[1]->{into} ) ? $_[1]->{into}
555 : ( ref $_[1] && defined $_[1]->{into_level} )
556 ? caller( $offset + $_[1]->{into_level} )
560 sub _make_unimport_sub {
562 my $exporting_package = shift;
564 my $export_recorder = shift;
565 my $is_reexport = shift;
566 my $meta_lookup = shift;
569 my $caller = scalar caller();
570 Moose::Exporter->_remove_keywords(
572 [ keys %{$exports} ],
579 sub _remove_keywords {
582 my $keywords = shift;
583 my $recorded_exports = shift;
584 my $is_reexport = shift;
588 foreach my $name ( @{$keywords} ) {
589 if ( defined &{ $package . '::' . $name } ) {
590 my $sub = \&{ $package . '::' . $name };
592 # make sure it is from us
593 next unless $recorded_exports->{$sub};
595 if ( $is_reexport->{$name} ) {
598 unless _export_is_flagged(
599 \*{ join q{::} => $package, $name } );
602 # and if it is from us, then undef the slot
603 delete ${ $package . '::' }{$name};
608 sub _make_init_meta {
612 my $meta_lookup = shift;
621 wrapped_method_metaclass
628 $old_style_roles{$role} = $args->{$role}
629 if exists $args->{$role};
632 my %base_class_roles;
633 %base_class_roles = ( roles => $args->{base_class_roles} )
634 if exists $args->{base_class_roles};
636 my %new_style_roles = map { $_ => $args->{$_} }
637 grep { exists $args->{$_} } qw( class_metaroles role_metaroles );
639 return unless %new_style_roles || %old_style_roles || %base_class_roles;
645 return unless $meta_lookup->( $options{for_class} );
647 if ( %new_style_roles || %old_style_roles ) {
648 Moose::Util::MetaRole::apply_metaroles(
649 for => $options{for_class},
655 Moose::Util::MetaRole::apply_base_class_roles(
656 for_class => $options{for_class},
659 if $meta_lookup->( $options{for_class} )
660 ->isa('Moose::Meta::Class');
662 return $meta_lookup->( $options{for_class} );
673 # ABSTRACT: make an import() and unimport() just like Moose.pm
679 package MyApp::Moose;
684 Moose::Exporter->setup_import_methods(
685 with_meta => [ 'has_rw', 'sugar2' ],
686 as_is => [ 'sugar3', \&Some::Random::thing ],
691 my ( $meta, $name, %options ) = @_;
692 $meta->add_attribute(
712 This module encapsulates the exporting of sugar functions in a
713 C<Moose.pm>-like manner. It does this by building custom C<import>,
714 C<unimport>, and C<init_meta> methods for your module, based on a spec you
717 It also lets you "stack" Moose-alike modules so you can export Moose's sugar
718 as well as your own, along with sugar from any random C<MooseX> module, as
719 long as they all use C<Moose::Exporter>. This feature exists to let you bundle
720 a set of MooseX modules into a policy module that developers can use directly
721 instead of using Moose itself.
723 To simplify writing exporter modules, C<Moose::Exporter> also imports
724 C<strict> and C<warnings> into your exporter module, as well as into
729 This module provides two public methods:
733 =item B<< Moose::Exporter->setup_import_methods(...) >>
735 When you call this method, C<Moose::Exporter> builds custom C<import>,
736 C<unimport>, and C<init_meta> methods for your module. The C<import> method
737 will export the functions you specify, and can also re-export functions
738 exported by some other module (like C<Moose.pm>).
740 The C<unimport> method cleans the caller's namespace of all the exported
741 functions. This includes any functions you re-export from other
742 packages. However, if the consumer of your package also imports those
743 functions from the original package, they will I<not> be cleaned.
745 If you pass any parameters for L<Moose::Util::MetaRole>, this method will
746 generate an C<init_meta> for you as well (see below for details). This
747 C<init_meta> will call C<Moose::Util::MetaRole::apply_metaroles> and
748 C<Moose::Util::MetaRole::apply_base_class_roles> as needed.
750 Note that if any of these methods already exist, they will not be
751 overridden, you will have to use C<build_import_methods> to get the
752 coderef that would be installed.
754 This method accepts the following parameters:
758 =item * with_meta => [ ... ]
760 This list of function I<names only> will be wrapped and then exported. The
761 wrapper will pass the metaclass object for the caller as its first argument.
763 Many sugar functions will need to use this metaclass object to do something to
766 =item * as_is => [ ... ]
768 This list of function names or sub references will be exported as-is. You can
769 identify a subroutine by reference, which is handy to re-export some other
770 module's functions directly by reference (C<\&Some::Package::function>).
772 If you do export some other package's function, this function will never be
773 removed by the C<unimport> method. The reason for this is we cannot know if
774 the caller I<also> explicitly imported the sub themselves, and therefore wants
777 =item * trait_aliases => [ ... ]
779 This is a list of package names which should have shortened aliases exported,
780 similar to the functionality of L<aliased>. Each element in the list can be
781 either a package name, in which case the export will be named as the last
782 namespace component of the package, or an arrayref, whose first element is the
783 package to alias to, and second element is the alias to export.
785 =item * also => $name or \@names
787 This is a list of modules which contain functions that the caller
788 wants to export. These modules must also use C<Moose::Exporter>. The
789 most common use case will be to export the functions from C<Moose.pm>.
790 Functions specified by C<with_meta> or C<as_is> take precedence over
791 functions exported by modules specified by C<also>, so that a module
792 can selectively override functions exported by another module.
794 C<Moose::Exporter> also makes sure all these functions get removed
795 when C<unimport> is called.
797 =item * meta_lookup => sub { ... }
799 This is a function which will be called to provide the metaclass
800 to be operated upon by the exporter. This is an advanced feature
801 intended for use by package generator modules in the vein of
802 L<MooseX::Role::Parameterized> in order to simplify reusing sugar
803 from other modules that use C<Moose::Exporter>. This function is
804 used, for example, to select the metaclass to bind to functions
805 that are exported using the C<with_meta> option.
807 This function will receive one parameter: the class name into which
808 the sugar is being exported. The default implementation is:
810 sub { Class::MOP::class_of(shift) }
812 Accordingly, this function is expected to return a metaclass.
816 You can also provide parameters for C<Moose::Util::MetaRole::apply_metaroles>
817 and C<Moose::Util::MetaRole::base_class_roles>. Specifically, valid parameters
818 are "class_metaroles", "role_metaroles", and "base_class_roles".
820 =item B<< Moose::Exporter->build_import_methods(...) >>
822 Returns two or three code refs, one for C<import>, one for
823 C<unimport>, and optionally one for C<init_meta>, if the appropriate
824 options are passed in.
826 Accepts the additional C<install> option, which accepts an arrayref of method
827 names to install into your exporting package. The valid options are C<import>,
828 C<unimport>, and C<init_meta>. Calling C<setup_import_methods> is equivalent
829 to calling C<build_import_methods> with C<< install => [qw(import unimport
830 init_meta)] >> except that it doesn't also return the methods.
832 The C<import> method is built using L<Sub::Exporter>. This means that it can
833 take a hashref of the form C<< { into => $package } >> to specify the package
836 Used by C<setup_import_methods>.
840 =head1 IMPORTING AND init_meta
842 If you want to set an alternative base object class or metaclass class, see
843 above for details on how this module can call L<Moose::Util::MetaRole> for
846 If you want to do something that is not supported by this module, simply
847 define an C<init_meta> method in your class. The C<import> method that
848 C<Moose::Exporter> generates for you will call this method (if it exists). It
849 will always pass the caller to this method via the C<for_class> parameter.
851 Most of the time, your C<init_meta> method will probably just call C<<
852 Moose->init_meta >> to do the real work:
855 shift; # our class name
856 return Moose->init_meta( @_, metaclass => 'My::Metaclass' );
859 Keep in mind that C<build_import_methods> will return an C<init_meta>
860 method for you, which you can also call from within your custom
863 my ( $import, $unimport, $init_meta )
864 = Moose::Exporter->build_import_methods(...);
871 # You can either pass an explicit package to import into ...
872 $class->$import( { into => scalar(caller) }, ... );
877 # ... or you can use 'goto' to provide the correct caller info to the
879 sub unimport { goto &$unimport }
886 $class->$init_meta(...);
891 =head1 METACLASS TRAITS
893 The C<import> method generated by C<Moose::Exporter> will allow the
894 user of your module to specify metaclass traits in a C<-traits>
895 parameter passed as part of the import:
897 use Moose -traits => 'My::Meta::Trait';
899 use Moose -traits => [ 'My::Meta::Trait', 'My::Other::Trait' ];
901 These traits will be applied to the caller's metaclass
902 instance. Providing traits for an exporting class that does not create
903 a metaclass for the caller is an error.
907 See L<Moose/BUGS> for details on reporting bugs.