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 intrepid 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 } );
138 my $exporting_package = shift;
140 _die_if_cycle_found_in_also_list_for_package($exporting_package);
142 return uniq( _follow_also_real($exporting_package) );
145 sub _follow_also_real {
146 my $exporting_package = shift;
147 my @also = _also_list_for_package($exporting_package);
149 return map { $_, _follow_also_real($_) } @also;
152 sub _also_list_for_package {
155 if ( !exists $EXPORT_SPEC{$package} ) {
156 my $loaded = is_class_loaded($package);
158 die "Package in also ($package) does not seem to "
159 . "use Moose::Exporter"
160 . ( $loaded ? "" : " (is it loaded?)" );
163 my $also = $EXPORT_SPEC{$package}{also};
165 return unless defined $also;
167 return ref $also ? @$also : $also;
170 # this is no Tarjan algorithm, but for the list sizes expected,
171 # brute force will probably be fine (and more maintainable)
172 sub _die_if_cycle_found_in_also_list_for_package {
174 _die_if_also_list_cycles_back_to_existing_stack(
175 [ _also_list_for_package($package) ],
180 sub _die_if_also_list_cycles_back_to_existing_stack {
181 my ( $also_list, $existing_stack ) = @_;
183 return unless @$also_list && @$existing_stack;
185 for my $also_member (@$also_list) {
186 for my $stack_member (@$existing_stack) {
187 next unless $also_member eq $stack_member;
190 "Circular reference in 'also' parameter to Moose::Exporter between "
194 ) . " and $also_member";
197 _die_if_also_list_cycles_back_to_existing_stack(
198 [ _also_list_for_package($also_member) ],
199 [ $also_member, @$existing_stack ],
204 sub _parse_trait_aliases {
206 my ($package, $aliases) = @_;
209 for my $alias (@$aliases) {
212 reftype($alias) eq 'ARRAY'
213 or Moose->throw_error(reftype($alias) . " references are not "
214 . "valid arguments to the 'trait_aliases' "
217 ($alias, $name) = @$alias;
220 ($name = $alias) =~ s/.*:://;
222 push @ret, subname "${package}::${name}" => sub () { $alias };
228 sub _make_sub_exporter_params {
230 my $packages = shift;
231 my $export_recorder = shift;
232 my $is_reexport = shift;
233 my $meta_lookup_override = shift;
236 my $current_meta_lookup;
238 for my $package ( @{$packages} ) {
239 my $args = $EXPORT_SPEC{$package}
240 or die "The $package package does not use Moose::Exporter\n";
242 $current_meta_lookup = $meta_lookup_override || $args->{meta_lookup};
243 $meta_lookup_override = $current_meta_lookup;
245 my $meta_lookup = $current_meta_lookup
246 || sub { Class::MOP::class_of(shift) };
248 for my $name ( @{ $args->{with_meta} } ) {
249 my $sub = $class->_sub_from_package( $package, $name )
252 my $fq_name = $package . '::' . $name;
254 $exports{$name} = $class->_make_wrapped_sub_with_meta(
259 ) unless exists $exports{$name};
262 for my $name ( @{ $args->{with_caller} } ) {
263 my $sub = $class->_sub_from_package( $package, $name )
266 my $fq_name = $package . '::' . $name;
268 $exports{$name} = $class->_make_wrapped_sub(
272 ) unless exists $exports{$name};
275 my @extra_exports = $class->_parse_trait_aliases(
276 $package, $args->{trait_aliases},
278 for my $name ( @{ $args->{as_is} }, @extra_exports ) {
279 my ( $sub, $coderef_name );
285 ( $coderef_pkg, $coderef_name )
286 = Class::MOP::get_code_info($name);
288 if ( $coderef_pkg ne $package ) {
289 $is_reexport->{$coderef_name} = 1;
293 $sub = $class->_sub_from_package( $package, $name )
296 $coderef_name = $name;
299 $export_recorder->{$sub} = 1;
301 $exports{$coderef_name} = sub { $sub }
302 unless exists $exports{$coderef_name};
309 sub _sub_from_package {
316 \&{ $package . '::' . $name };
319 return $sub if defined &$sub;
321 Carp::cluck "Trying to export undefined sub ${package}::${name}";
328 sub _make_wrapped_sub {
332 my $export_recorder = shift;
334 # We need to set the package at import time, so that when
335 # package Foo imports has(), we capture "Foo" as the
336 # package. This lets other packages call Foo::has() and get
337 # the right package. This is done for backwards compatibility
338 # with existing production code, not because this is a good
341 my $caller = $CALLER;
343 my $wrapper = $self->_curry_wrapper( $sub, $fq_name, $caller );
345 my $sub = subname( $fq_name => $wrapper );
347 $export_recorder->{$sub} = 1;
353 sub _make_wrapped_sub_with_meta {
357 my $export_recorder = shift;
358 my $meta_lookup = shift;
361 my $caller = $CALLER;
363 my $wrapper = $self->_late_curry_wrapper(
365 $meta_lookup => $caller
368 my $sub = subname( $fq_name => $wrapper );
370 $export_recorder->{$sub} = 1;
382 my $wrapper = sub { $sub->( @extra, @_ ) };
383 if ( my $proto = prototype $sub ) {
385 # XXX - Perl's prototype sucks. Use & to make set_prototype
386 # ignore the fact that we're passing "private variables"
387 &Scalar::Util::set_prototype( $wrapper, $proto );
392 sub _late_curry_wrapper {
401 # resolve curried arguments at runtime via this closure
402 my @curry = ( $extra->(@ex_args) );
403 return $sub->( @curry, @_ );
406 if ( my $proto = prototype $sub ) {
408 # XXX - Perl's prototype sucks. Use & to make set_prototype
409 # ignore the fact that we're passing "private variables"
410 &Scalar::Util::set_prototype( $wrapper, $proto );
415 sub _make_import_sub {
417 my $exporting_package = shift;
418 my $exporter = shift;
419 my $exports_from = shift;
420 my $is_reexport = shift;
421 my $meta_lookup = shift;
425 # I think we could use Sub::Exporter's collector feature
426 # to do this, but that would be rather gross, since that
427 # feature isn't really designed to return a value to the
428 # caller of the exporter sub.
430 # Also, this makes sure we preserve backwards compat for
431 # _get_caller, so it always sees the arguments in the
434 ( $traits, @_ ) = _strip_traits(@_);
437 ( $metaclass, @_ ) = _strip_metaclass(@_);
439 = Moose::Util::resolve_metaclass_alias( 'Class' => $metaclass )
440 if defined $metaclass && length $metaclass;
443 ( $meta_name, @_ ) = _strip_meta_name(@_);
445 # Normally we could look at $_[0], but in some weird cases
446 # (involving goto &Moose::import), $_[0] ends as something
447 # else (like Squirrel).
448 my $class = $exporting_package;
450 $CALLER = _get_caller(@_);
452 # this works because both pragmas set $^H (see perldoc
453 # perlvar) which affects the current compilation -
454 # i.e. the file who use'd us - which is why we don't need
455 # to do anything special to make it affect that file
456 # rather than this one (which is already compiled)
462 for my $c ( grep { $_->can('init_meta') } $class, @{$exports_from} ) {
464 # init_meta can apply a role, which when loaded uses
465 # Moose::Exporter, which in turn sets $CALLER, so we need
466 # to protect against that.
467 local $CALLER = $CALLER;
469 for_class => $CALLER,
470 metaclass => $metaclass,
471 meta_name => $meta_name,
477 # The metaroles will use Moose::Role, which in turn uses
478 # Moose::Exporter, which in turn sets $CALLER, so we need
479 # to protect against that.
480 local $CALLER = $CALLER;
483 [$class, @$exports_from],
488 if ( $did_init_meta && @{$traits} ) {
490 # The traits will use Moose::Role, which in turn uses
491 # Moose::Exporter, which in turn sets $CALLER, so we need
492 # to protect against that.
493 local $CALLER = $CALLER;
494 _apply_meta_traits( $CALLER, $traits, $meta_lookup );
496 elsif ( @{$traits} ) {
499 "Cannot provide traits when $class does not have an init_meta() method"
503 my ( undef, @args ) = @_;
504 my $extra = shift @args if ref $args[0] eq 'HASH';
507 if ( !$extra->{into} ) {
508 $extra->{into_level} ||= 0;
509 $extra->{into_level}++;
512 $class->$exporter( $extra, @args );
517 my $idx = first_index { ( $_ || '' ) eq '-traits' } @_;
519 return ( [], @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
521 my $traits = $_[ $idx + 1 ];
525 $traits = [$traits] unless ref $traits;
527 return ( $traits, @_ );
530 sub _strip_metaclass {
531 my $idx = first_index { ( $_ || '' ) eq '-metaclass' } @_;
533 return ( undef, @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
535 my $metaclass = $_[ $idx + 1 ];
539 return ( $metaclass, @_ );
542 sub _strip_meta_name {
543 my $idx = first_index { ( $_ || '' ) eq '-meta_name' } @_;
545 return ( 'meta', @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
547 my $meta_name = $_[ $idx + 1 ];
551 return ( $meta_name, @_ );
554 sub _apply_metaroles {
555 my ($class, $exports_from, $meta_lookup) = @_;
557 my $metaroles = _collect_metaroles($exports_from);
558 my $base_class_roles = delete $metaroles->{base_class_roles};
560 my $meta = $meta_lookup->($class);
561 # for instance, Moose.pm uses Moose::Util::TypeConstraints
564 Moose::Util::MetaRole::apply_metaroles(
567 ) if keys %$metaroles;
569 Moose::Util::MetaRole::apply_base_class_roles(
571 roles => $base_class_roles,
572 ) if $meta->isa('Class::MOP::Class')
573 && $base_class_roles && @$base_class_roles;
576 sub _collect_metaroles {
577 my ($exports_from) = @_;
579 my @old_style_role_types = map { "${_}_roles" } qw(
583 wrapped_method_metaclass
592 my @base_class_roles;
595 for my $exporter (@$exports_from) {
596 my $data = $EXPORT_SPEC{$exporter};
598 if (exists $data->{class_metaroles}) {
599 for my $type (keys %{ $data->{class_metaroles} }) {
600 push @{ $class_metaroles{$type} ||= [] },
601 @{ $data->{class_metaroles}{$type} };
605 if (exists $data->{role_metaroles}) {
606 for my $type (keys %{ $data->{role_metaroles} }) {
607 push @{ $role_metaroles{$type} ||= [] },
608 @{ $data->{role_metaroles}{$type} };
612 if (exists $data->{base_class_roles}) {
613 push @base_class_roles, @{ $data->{base_class_roles} };
616 for my $type (@old_style_role_types) {
617 if (exists $data->{$type}) {
618 push @{ $old_style_roles{$type} ||= [] },
625 (keys(%class_metaroles)
626 ? (class_metaroles => \%class_metaroles)
628 (keys(%role_metaroles)
629 ? (role_metaroles => \%role_metaroles)
632 ? (base_class_roles => \@base_class_roles)
638 sub _apply_meta_traits {
639 my ( $class, $traits, $meta_lookup ) = @_;
641 return unless @{$traits};
643 my $meta = $meta_lookup->($class);
645 my $type = ( split /::/, ref $meta )[-1]
646 or Moose->throw_error(
647 'Cannot determine metaclass type for trait application . Meta isa '
650 my @resolved_traits = map {
653 : Moose::Util::resolve_metatrait_alias( $type => $_ )
656 return unless @resolved_traits;
658 my %args = ( for => $class );
660 if ( $meta->isa('Moose::Meta::Role') ) {
661 $args{role_metaroles} = { role => \@resolved_traits };
664 $args{class_metaroles} = { class => \@resolved_traits };
667 Moose::Util::MetaRole::apply_metaroles(%args);
672 # 1 extra level because it's called by import so there's a layer
677 ( ref $_[1] && defined $_[1]->{into} ) ? $_[1]->{into}
678 : ( ref $_[1] && defined $_[1]->{into_level} )
679 ? caller( $offset + $_[1]->{into_level} )
683 sub _make_unimport_sub {
685 my $exporting_package = shift;
687 my $export_recorder = shift;
688 my $is_reexport = shift;
689 my $meta_lookup = shift;
692 my $caller = scalar caller();
693 Moose::Exporter->_remove_keywords(
695 [ keys %{$exports} ],
702 sub _remove_keywords {
705 my $keywords = shift;
706 my $recorded_exports = shift;
707 my $is_reexport = shift;
711 foreach my $name ( @{$keywords} ) {
712 if ( defined &{ $package . '::' . $name } ) {
713 my $sub = \&{ $package . '::' . $name };
715 # make sure it is from us
716 next unless $recorded_exports->{$sub};
718 if ( $is_reexport->{$name} ) {
721 unless _export_is_flagged(
722 \*{ join q{::} => $package, $name } );
725 # and if it is from us, then undef the slot
726 delete ${ $package . '::' }{$name};
731 # maintain this for now for backcompat
732 # make sure to return a sub to install in the same circumstances as previously
733 # but this functionality now happens at the end of ->import
734 sub _make_init_meta {
738 my $meta_lookup = shift;
747 wrapped_method_metaclass
754 $old_style_roles{$role} = $args->{$role}
755 if exists $args->{$role};
758 my %base_class_roles;
759 %base_class_roles = ( roles => $args->{base_class_roles} )
760 if exists $args->{base_class_roles};
762 my %new_style_roles = map { $_ => $args->{$_} }
763 grep { exists $args->{$_} } qw( class_metaroles role_metaroles );
765 return unless %new_style_roles || %old_style_roles || %base_class_roles;
770 $meta_lookup->($opts{for_class});
781 # ABSTRACT: make an import() and unimport() just like Moose.pm
787 package MyApp::Moose;
792 Moose::Exporter->setup_import_methods(
793 with_meta => [ 'has_rw', 'sugar2' ],
794 as_is => [ 'sugar3', \&Some::Random::thing ],
799 my ( $meta, $name, %options ) = @_;
800 $meta->add_attribute(
820 This module encapsulates the exporting of sugar functions in a
821 C<Moose.pm>-like manner. It does this by building custom C<import> and
822 C<unimport> methods for your module, based on a spec you provide.
824 It also lets you "stack" Moose-alike modules so you can export Moose's sugar
825 as well as your own, along with sugar from any random C<MooseX> module, as
826 long as they all use C<Moose::Exporter>. This feature exists to let you bundle
827 a set of MooseX modules into a policy module that developers can use directly
828 instead of using Moose itself.
830 To simplify writing exporter modules, C<Moose::Exporter> also imports
831 C<strict> and C<warnings> into your exporter module, as well as into
836 This module provides two public methods:
840 =item B<< Moose::Exporter->setup_import_methods(...) >>
842 When you call this method, C<Moose::Exporter> builds custom C<import> and
843 C<unimport> methods for your module. The C<import> method
844 will export the functions you specify, and can also re-export functions
845 exported by some other module (like C<Moose.pm>). If you pass any parameters
846 for L<Moose::Util::MetaRole>, the C<import> method will also call
847 C<Moose::Util::MetaRole::apply_metaroles> and
848 C<Moose::Util::MetaRole::apply_base_class_roles> as needed, after making
849 sure the metaclass is initialized.
851 The C<unimport> method cleans the caller's namespace of all the exported
852 functions. This includes any functions you re-export from other
853 packages. However, if the consumer of your package also imports those
854 functions from the original package, they will I<not> be cleaned.
856 Note that if any of these methods already exist, they will not be
857 overridden, you will have to use C<build_import_methods> to get the
858 coderef that would be installed.
860 This method accepts the following parameters:
864 =item * with_meta => [ ... ]
866 This list of function I<names only> will be wrapped and then exported. The
867 wrapper will pass the metaclass object for the caller as its first argument.
869 Many sugar functions will need to use this metaclass object to do something to
872 =item * as_is => [ ... ]
874 This list of function names or sub references will be exported as-is. You can
875 identify a subroutine by reference, which is handy to re-export some other
876 module's functions directly by reference (C<\&Some::Package::function>).
878 If you do export some other package's function, this function will never be
879 removed by the C<unimport> method. The reason for this is we cannot know if
880 the caller I<also> explicitly imported the sub themselves, and therefore wants
883 =item * trait_aliases => [ ... ]
885 This is a list of package names which should have shortened aliases exported,
886 similar to the functionality of L<aliased>. Each element in the list can be
887 either a package name, in which case the export will be named as the last
888 namespace component of the package, or an arrayref, whose first element is the
889 package to alias to, and second element is the alias to export.
891 =item * also => $name or \@names
893 This is a list of modules which contain functions that the caller
894 wants to export. These modules must also use C<Moose::Exporter>. The
895 most common use case will be to export the functions from C<Moose.pm>.
896 Functions specified by C<with_meta> or C<as_is> take precedence over
897 functions exported by modules specified by C<also>, so that a module
898 can selectively override functions exported by another module.
900 C<Moose::Exporter> also makes sure all these functions get removed
901 when C<unimport> is called.
903 =item * meta_lookup => sub { ... }
905 This is a function which will be called to provide the metaclass
906 to be operated upon by the exporter. This is an advanced feature
907 intended for use by package generator modules in the vein of
908 L<MooseX::Role::Parameterized> in order to simplify reusing sugar
909 from other modules that use C<Moose::Exporter>. This function is
910 used, for example, to select the metaclass to bind to functions
911 that are exported using the C<with_meta> option.
913 This function will receive one parameter: the class name into which
914 the sugar is being exported. The default implementation is:
916 sub { Class::MOP::class_of(shift) }
918 Accordingly, this function is expected to return a metaclass.
922 You can also provide parameters for C<Moose::Util::MetaRole::apply_metaroles>
923 and C<Moose::Util::MetaRole::base_class_roles>. Specifically, valid parameters
924 are "class_metaroles", "role_metaroles", and "base_class_roles".
926 =item B<< Moose::Exporter->build_import_methods(...) >>
928 Returns two code refs, one for C<import> and one for C<unimport>.
930 Accepts the additional C<install> option, which accepts an arrayref of method
931 names to install into your exporting package. The valid options are C<import>
932 and C<unimport>. Calling C<setup_import_methods> is equivalent
933 to calling C<build_import_methods> with C<< install => [qw(import unimport)] >>
934 except that it doesn't also return the methods.
936 The C<import> method is built using L<Sub::Exporter>. This means that it can
937 take a hashref of the form C<< { into => $package } >> to specify the package
940 Used by C<setup_import_methods>.
944 =head1 IMPORTING AND init_meta
946 If you want to set an alternative base object class or metaclass class, see
947 above for details on how this module can call L<Moose::Util::MetaRole> for
950 If you want to do something that is not supported by this module, simply
951 define an C<init_meta> method in your class. The C<import> method that
952 C<Moose::Exporter> generates for you will call this method (if it exists). It
953 will always pass the caller to this method via the C<for_class> parameter.
955 Most of the time, your C<init_meta> method will probably just call C<<
956 Moose->init_meta >> to do the real work:
959 shift; # our class name
960 return Moose->init_meta( @_, metaclass => 'My::Metaclass' );
963 =head1 METACLASS TRAITS
965 The C<import> method generated by C<Moose::Exporter> will allow the
966 user of your module to specify metaclass traits in a C<-traits>
967 parameter passed as part of the import:
969 use Moose -traits => 'My::Meta::Trait';
971 use Moose -traits => [ 'My::Meta::Trait', 'My::Other::Trait' ];
973 These traits will be applied to the caller's metaclass
974 instance. Providing traits for an exporting class that does not create
975 a metaclass for the caller is an error.
979 See L<Moose/BUGS> for details on reporting bugs.