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 @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,
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;
750 # ABSTRACT: make an import() and unimport() just like Moose.pm
756 package MyApp::Moose;
761 Moose::Exporter->setup_import_methods(
762 with_meta => [ 'has_rw', 'sugar2' ],
763 as_is => [ 'sugar3', \&Some::Random::thing ],
768 my ( $meta, $name, %options ) = @_;
769 $meta->add_attribute(
789 This module encapsulates the exporting of sugar functions in a
790 C<Moose.pm>-like manner. It does this by building custom C<import> and
791 C<unimport> methods for your module, based on a spec you provide.
793 It also lets you "stack" Moose-alike modules so you can export Moose's sugar
794 as well as your own, along with sugar from any random C<MooseX> module, as
795 long as they all use C<Moose::Exporter>. This feature exists to let you bundle
796 a set of MooseX modules into a policy module that developers can use directly
797 instead of using Moose itself.
799 To simplify writing exporter modules, C<Moose::Exporter> also imports
800 C<strict> and C<warnings> into your exporter module, as well as into
805 This module provides two public methods:
809 =item B<< Moose::Exporter->setup_import_methods(...) >>
811 When you call this method, C<Moose::Exporter> builds custom C<import> and
812 C<unimport> methods for your module. The C<import> method
813 will export the functions you specify, and can also re-export functions
814 exported by some other module (like C<Moose.pm>). If you pass any parameters
815 for L<Moose::Util::MetaRole>, the C<import> method will also call
816 C<Moose::Util::MetaRole::apply_metaroles> and
817 C<Moose::Util::MetaRole::apply_base_class_roles> as needed, after making
818 sure the metaclass is initialized.
820 The C<unimport> method cleans the caller's namespace of all the exported
821 functions. This includes any functions you re-export from other
822 packages. However, if the consumer of your package also imports those
823 functions from the original package, they will I<not> be cleaned.
825 Note that if any of these methods already exist, they will not be
826 overridden, you will have to use C<build_import_methods> to get the
827 coderef that would be installed.
829 This method accepts the following parameters:
833 =item * with_meta => [ ... ]
835 This list of function I<names only> will be wrapped and then exported. The
836 wrapper will pass the metaclass object for the caller as its first argument.
838 Many sugar functions will need to use this metaclass object to do something to
841 =item * as_is => [ ... ]
843 This list of function names or sub references will be exported as-is. You can
844 identify a subroutine by reference, which is handy to re-export some other
845 module's functions directly by reference (C<\&Some::Package::function>).
847 If you do export some other package's function, this function will never be
848 removed by the C<unimport> method. The reason for this is we cannot know if
849 the caller I<also> explicitly imported the sub themselves, and therefore wants
852 =item * trait_aliases => [ ... ]
854 This is a list of package names which should have shortened aliases exported,
855 similar to the functionality of L<aliased>. Each element in the list can be
856 either a package name, in which case the export will be named as the last
857 namespace component of the package, or an arrayref, whose first element is the
858 package to alias to, and second element is the alias to export.
860 =item * also => $name or \@names
862 This is a list of modules which contain functions that the caller
863 wants to export. These modules must also use C<Moose::Exporter>. The
864 most common use case will be to export the functions from C<Moose.pm>.
865 Functions specified by C<with_meta> or C<as_is> take precedence over
866 functions exported by modules specified by C<also>, so that a module
867 can selectively override functions exported by another module.
869 C<Moose::Exporter> also makes sure all these functions get removed
870 when C<unimport> is called.
872 =item * meta_lookup => sub { ... }
874 This is a function which will be called to provide the metaclass
875 to be operated upon by the exporter. This is an advanced feature
876 intended for use by package generator modules in the vein of
877 L<MooseX::Role::Parameterized> in order to simplify reusing sugar
878 from other modules that use C<Moose::Exporter>. This function is
879 used, for example, to select the metaclass to bind to functions
880 that are exported using the C<with_meta> option.
882 This function will receive one parameter: the class name into which
883 the sugar is being exported. The default implementation is:
885 sub { Class::MOP::class_of(shift) }
887 Accordingly, this function is expected to return a metaclass.
891 You can also provide parameters for C<Moose::Util::MetaRole::apply_metaroles>
892 and C<Moose::Util::MetaRole::base_class_roles>. Specifically, valid parameters
893 are "class_metaroles", "role_metaroles", and "base_class_roles".
895 =item B<< Moose::Exporter->build_import_methods(...) >>
897 Returns two code refs, one for C<import> and one for C<unimport>.
899 Accepts the additional C<install> option, which accepts an arrayref of method
900 names to install into your exporting package. The valid options are C<import>
901 and C<unimport>. Calling C<setup_import_methods> is equivalent
902 to calling C<build_import_methods> with C<< install => [qw(import unimport)] >>
903 except that it doesn't also return the methods.
905 The C<import> method is built using L<Sub::Exporter>. This means that it can
906 take a hashref of the form C<< { into => $package } >> to specify the package
909 Used by C<setup_import_methods>.
913 =head1 IMPORTING AND init_meta
915 If you want to set an alternative base object class or metaclass class, see
916 above for details on how this module can call L<Moose::Util::MetaRole> for
919 If you want to do something that is not supported by this module, simply
920 define an C<init_meta> method in your class. The C<import> method that
921 C<Moose::Exporter> generates for you will call this method (if it exists). It
922 will always pass the caller to this method via the C<for_class> parameter.
924 Most of the time, your C<init_meta> method will probably just call C<<
925 Moose->init_meta >> to do the real work:
928 shift; # our class name
929 return Moose->init_meta( @_, metaclass => 'My::Metaclass' );
932 =head1 METACLASS TRAITS
934 The C<import> method generated by C<Moose::Exporter> will allow the
935 user of your module to specify metaclass traits in a C<-traits>
936 parameter passed as part of the import:
938 use Moose -traits => 'My::Meta::Trait';
940 use Moose -traits => [ 'My::Meta::Trait', 'My::Other::Trait' ];
942 These traits will be applied to the caller's metaclass
943 instance. Providing traits for an exporting class that does not create
944 a metaclass for the caller is an error.
948 See L<Moose/BUGS> for details on reporting bugs.