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 } );
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 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,
450 # The metaroles will use Moose::Role, which in turn uses
451 # Moose::Exporter, which in turn sets $CALLER, so we need
452 # to protect against that.
453 local $CALLER = $CALLER;
456 [$class, @$exports_from],
461 if ( $did_init_meta && @{$traits} ) {
463 # The traits will use Moose::Role, which in turn uses
464 # Moose::Exporter, which in turn sets $CALLER, so we need
465 # to protect against that.
466 local $CALLER = $CALLER;
467 _apply_meta_traits( $CALLER, $traits, $meta_lookup );
469 elsif ( @{$traits} ) {
472 "Cannot provide traits when $class does not have an init_meta() method"
476 my ( undef, @args ) = @_;
477 my $extra = shift @args if ref $args[0] eq 'HASH';
480 if ( !$extra->{into} ) {
481 $extra->{into_level} ||= 0;
482 $extra->{into_level}++;
485 $class->$exporter( $extra, @args );
490 my $idx = first_index { ( $_ || '' ) eq '-traits' } @_;
492 return ( [], @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
494 my $traits = $_[ $idx + 1 ];
498 $traits = [$traits] unless ref $traits;
500 return ( $traits, @_ );
503 sub _strip_metaclass {
504 my $idx = first_index { ( $_ || '' ) eq '-metaclass' } @_;
506 return ( undef, @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
508 my $metaclass = $_[ $idx + 1 ];
512 return ( $metaclass, @_ );
515 sub _strip_meta_name {
516 my $idx = first_index { ( $_ || '' ) eq '-meta_name' } @_;
518 return ( 'meta', @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
520 my $meta_name = $_[ $idx + 1 ];
524 return ( $meta_name, @_ );
527 sub _apply_metaroles {
528 my ($class, $exports_from, $meta_lookup) = @_;
530 my $metaroles = _collect_metaroles($exports_from);
531 my $base_class_roles = delete $metaroles->{base_class_roles};
533 my $meta = $meta_lookup->($class);
534 # for instance, Moose.pm uses Moose::Util::TypeConstraints
537 Moose::Util::MetaRole::apply_metaroles(
540 ) if keys %$metaroles;
542 Moose::Util::MetaRole::apply_base_class_roles(
544 roles => $base_class_roles,
545 ) if $meta->isa('Class::MOP::Class')
546 && $base_class_roles && @$base_class_roles;
549 sub _collect_metaroles {
550 my ($exports_from) = @_;
552 my @old_style_role_types = map { "${_}_roles" } qw(
556 wrapped_method_metaclass
565 my @base_class_roles;
568 for my $exporter (@$exports_from) {
569 my $data = $EXPORT_SPEC{$exporter};
571 if (exists $data->{class_metaroles}) {
572 for my $type (keys %{ $data->{class_metaroles} }) {
573 push @{ $class_metaroles{$type} ||= [] },
574 @{ $data->{class_metaroles}{$type} };
578 if (exists $data->{role_metaroles}) {
579 for my $type (keys %{ $data->{role_metaroles} }) {
580 push @{ $role_metaroles{$type} ||= [] },
581 @{ $data->{role_metaroles}{$type} };
585 if (exists $data->{base_class_roles}) {
586 push @base_class_roles, @{ $data->{base_class_roles} };
589 for my $type (@old_style_role_types) {
590 if (exists $data->{$type}) {
591 push @{ $old_style_roles{$type} ||= [] },
598 (keys(%class_metaroles)
599 ? (class_metaroles => \%class_metaroles)
601 (keys(%role_metaroles)
602 ? (role_metaroles => \%role_metaroles)
605 ? (base_class_roles => \@base_class_roles)
611 sub _apply_meta_traits {
612 my ( $class, $traits, $meta_lookup ) = @_;
614 return unless @{$traits};
616 my $meta = $meta_lookup->($class);
618 my $type = ( split /::/, ref $meta )[-1]
619 or Moose->throw_error(
620 'Cannot determine metaclass type for trait application . Meta isa '
623 my @resolved_traits = map {
626 : Moose::Util::resolve_metatrait_alias( $type => $_ )
629 return unless @resolved_traits;
631 my %args = ( for => $class );
633 if ( $meta->isa('Moose::Meta::Role') ) {
634 $args{role_metaroles} = { role => \@resolved_traits };
637 $args{class_metaroles} = { class => \@resolved_traits };
640 Moose::Util::MetaRole::apply_metaroles(%args);
645 # 1 extra level because it's called by import so there's a layer
650 ( ref $_[1] && defined $_[1]->{into} ) ? $_[1]->{into}
651 : ( ref $_[1] && defined $_[1]->{into_level} )
652 ? caller( $offset + $_[1]->{into_level} )
656 sub _make_unimport_sub {
658 my $exporting_package = shift;
660 my $export_recorder = shift;
661 my $is_reexport = shift;
662 my $meta_lookup = shift;
665 my $caller = scalar caller();
666 Moose::Exporter->_remove_keywords(
668 [ keys %{$exports} ],
675 sub _remove_keywords {
678 my $keywords = shift;
679 my $recorded_exports = shift;
680 my $is_reexport = shift;
684 foreach my $name ( @{$keywords} ) {
685 if ( defined &{ $package . '::' . $name } ) {
686 my $sub = \&{ $package . '::' . $name };
688 # make sure it is from us
689 next unless $recorded_exports->{$sub};
691 if ( $is_reexport->{$name} ) {
694 unless _export_is_flagged(
695 \*{ join q{::} => $package, $name } );
698 # and if it is from us, then undef the slot
699 delete ${ $package . '::' }{$name};
704 # maintain this for now for backcompat
705 # make sure to return a sub to install in the same circumstances as previously
706 # but this functionality now happens at the end of ->import
707 sub _make_init_meta {
711 my $meta_lookup = shift;
720 wrapped_method_metaclass
727 $old_style_roles{$role} = $args->{$role}
728 if exists $args->{$role};
731 my %base_class_roles;
732 %base_class_roles = ( roles => $args->{base_class_roles} )
733 if exists $args->{base_class_roles};
735 my %new_style_roles = map { $_ => $args->{$_} }
736 grep { exists $args->{$_} } qw( class_metaroles role_metaroles );
738 return unless %new_style_roles || %old_style_roles || %base_class_roles;
743 $meta_lookup->($opts{for_class});
754 # ABSTRACT: make an import() and unimport() just like Moose.pm
760 package MyApp::Moose;
765 Moose::Exporter->setup_import_methods(
766 with_meta => [ 'has_rw', 'sugar2' ],
767 as_is => [ 'sugar3', \&Some::Random::thing ],
772 my ( $meta, $name, %options ) = @_;
773 $meta->add_attribute(
793 This module encapsulates the exporting of sugar functions in a
794 C<Moose.pm>-like manner. It does this by building custom C<import> and
795 C<unimport> methods for your module, based on a spec you provide.
797 It also lets you "stack" Moose-alike modules so you can export Moose's sugar
798 as well as your own, along with sugar from any random C<MooseX> module, as
799 long as they all use C<Moose::Exporter>. This feature exists to let you bundle
800 a set of MooseX modules into a policy module that developers can use directly
801 instead of using Moose itself.
803 To simplify writing exporter modules, C<Moose::Exporter> also imports
804 C<strict> and C<warnings> into your exporter module, as well as into
809 This module provides two public methods:
813 =item B<< Moose::Exporter->setup_import_methods(...) >>
815 When you call this method, C<Moose::Exporter> builds custom C<import> and
816 C<unimport> methods for your module. The C<import> method
817 will export the functions you specify, and can also re-export functions
818 exported by some other module (like C<Moose.pm>). If you pass any parameters
819 for L<Moose::Util::MetaRole>, the C<import> method will also call
820 C<Moose::Util::MetaRole::apply_metaroles> and
821 C<Moose::Util::MetaRole::apply_base_class_roles> as needed, after making
822 sure the metaclass is initialized.
824 The C<unimport> method cleans the caller's namespace of all the exported
825 functions. This includes any functions you re-export from other
826 packages. However, if the consumer of your package also imports those
827 functions from the original package, they will I<not> be cleaned.
829 Note that if any of these methods already exist, they will not be
830 overridden, you will have to use C<build_import_methods> to get the
831 coderef that would be installed.
833 This method accepts the following parameters:
837 =item * with_meta => [ ... ]
839 This list of function I<names only> will be wrapped and then exported. The
840 wrapper will pass the metaclass object for the caller as its first argument.
842 Many sugar functions will need to use this metaclass object to do something to
845 =item * as_is => [ ... ]
847 This list of function names or sub references will be exported as-is. You can
848 identify a subroutine by reference, which is handy to re-export some other
849 module's functions directly by reference (C<\&Some::Package::function>).
851 If you do export some other package's function, this function will never be
852 removed by the C<unimport> method. The reason for this is we cannot know if
853 the caller I<also> explicitly imported the sub themselves, and therefore wants
856 =item * trait_aliases => [ ... ]
858 This is a list of package names which should have shortened aliases exported,
859 similar to the functionality of L<aliased>. Each element in the list can be
860 either a package name, in which case the export will be named as the last
861 namespace component of the package, or an arrayref, whose first element is the
862 package to alias to, and second element is the alias to export.
864 =item * also => $name or \@names
866 This is a list of modules which contain functions that the caller
867 wants to export. These modules must also use C<Moose::Exporter>. The
868 most common use case will be to export the functions from C<Moose.pm>.
869 Functions specified by C<with_meta> or C<as_is> take precedence over
870 functions exported by modules specified by C<also>, so that a module
871 can selectively override functions exported by another module.
873 C<Moose::Exporter> also makes sure all these functions get removed
874 when C<unimport> is called.
876 =item * meta_lookup => sub { ... }
878 This is a function which will be called to provide the metaclass
879 to be operated upon by the exporter. This is an advanced feature
880 intended for use by package generator modules in the vein of
881 L<MooseX::Role::Parameterized> in order to simplify reusing sugar
882 from other modules that use C<Moose::Exporter>. This function is
883 used, for example, to select the metaclass to bind to functions
884 that are exported using the C<with_meta> option.
886 This function will receive one parameter: the class name into which
887 the sugar is being exported. The default implementation is:
889 sub { Class::MOP::class_of(shift) }
891 Accordingly, this function is expected to return a metaclass.
895 You can also provide parameters for C<Moose::Util::MetaRole::apply_metaroles>
896 and C<Moose::Util::MetaRole::base_class_roles>. Specifically, valid parameters
897 are "class_metaroles", "role_metaroles", and "base_class_roles".
899 =item B<< Moose::Exporter->build_import_methods(...) >>
901 Returns two code refs, one for C<import> and one for C<unimport>.
903 Accepts the additional C<install> option, which accepts an arrayref of method
904 names to install into your exporting package. The valid options are C<import>
905 and C<unimport>. Calling C<setup_import_methods> is equivalent
906 to calling C<build_import_methods> with C<< install => [qw(import unimport)] >>
907 except that it doesn't also return the methods.
909 The C<import> method is built using L<Sub::Exporter>. This means that it can
910 take a hashref of the form C<< { into => $package } >> to specify the package
913 Used by C<setup_import_methods>.
917 =head1 IMPORTING AND init_meta
919 If you want to set an alternative base object class or metaclass class, see
920 above for details on how this module can call L<Moose::Util::MetaRole> for
923 If you want to do something that is not supported by this module, simply
924 define an C<init_meta> method in your class. The C<import> method that
925 C<Moose::Exporter> generates for you will call this method (if it exists). It
926 will always pass the caller to this method via the C<for_class> parameter.
928 Most of the time, your C<init_meta> method will probably just call C<<
929 Moose->init_meta >> to do the real work:
932 shift; # our class name
933 return Moose->init_meta( @_, metaclass => 'My::Metaclass' );
936 =head1 METACLASS TRAITS
938 The C<import> method generated by C<Moose::Exporter> will allow the
939 user of your module to specify metaclass traits in a C<-traits>
940 parameter passed as part of the import:
942 use Moose -traits => 'My::Meta::Trait';
944 use Moose -traits => [ 'My::Meta::Trait', 'My::Other::Trait' ];
946 These traits will be applied to the caller's metaclass
947 instance. Providing traits for an exporting class that does not create
948 a metaclass for the caller is an error.
952 See L<Moose/BUGS> for details on reporting bugs.