1 package Moose::Exporter;
6 our $AUTHORITY = 'cpan:STEVAN';
9 use List::MoreUtils qw( first_index uniq );
10 use Moose::Util::MetaRole;
11 use Scalar::Util qw(reftype);
12 use Sub::Exporter 0.980;
13 use Sub::Name qw(subname);
17 XSLoader::load( 'Moose', $XS_VERSION );
21 sub setup_import_methods {
22 my ( $class, %args ) = @_;
24 my $exporting_package = $args{exporting_package} ||= caller();
26 $class->build_import_methods(
28 install => [qw(import unimport init_meta)]
32 sub build_import_methods {
33 my ( $class, %args ) = @_;
35 my $exporting_package = $args{exporting_package} ||= caller();
37 $EXPORT_SPEC{$exporting_package} = \%args;
39 my @exports_from = $class->_follow_also($exporting_package);
41 my $export_recorder = {};
44 my $exports = $class->_make_sub_exporter_params(
45 [ @exports_from, $exporting_package ],
50 my $exporter = $class->_make_exporter($exports, $is_reexport);
53 $methods{import} = $class->_make_import_sub(
60 $methods{unimport} = $class->_make_unimport_sub(
67 $methods{init_meta} = $class->_make_init_meta(
72 my $package = Class::MOP::Package->initialize($exporting_package);
73 for my $to_install ( @{ $args{install} || [] } ) {
74 my $symbol = '&' . $to_install;
76 unless $methods{$to_install}
77 && !$package->has_package_symbol($symbol);
78 $package->add_package_symbol( $symbol, $methods{$to_install} );
81 return ( $methods{import}, $methods{unimport}, $methods{init_meta} );
85 my ($class, $exports, $is_reexport) = @_;
87 return Sub::Exporter::build_exporter(
90 groups => { default => [':all'] },
92 my ($arg, $to_export) = @_;
93 my $meta = Class::MOP::class_of($arg->{into});
95 goto &Sub::Exporter::default_installer unless $meta;
97 # don't overwrite existing symbols with our magically flagged
98 # version of it if we would install the same sub that's already
101 my @filtered_to_export;
103 for (my $i = 0; $i < @{ $to_export }; $i += 2) {
104 my ($as, $cv) = @{ $to_export }[$i, $i + 1];
107 && $meta->has_package_symbol('&' . $as)
108 && $meta->get_package_symbol('&' . $as) == $cv;
110 push @filtered_to_export, $as, $cv;
111 $installed{$as} = 1 unless ref $as;
114 Sub::Exporter::default_installer($arg, \@filtered_to_export);
116 for my $name ( keys %{$is_reexport} ) {
119 next unless exists $installed{$name};
120 _flag_as_reexport( \*{ join q{::}, $arg->{into}, $name } );
132 my $exporting_package = shift;
134 local %$seen = ( $exporting_package => 1 );
136 return uniq( _follow_also_real($exporting_package) );
139 sub _follow_also_real {
140 my $exporting_package = shift;
142 if ( !exists $EXPORT_SPEC{$exporting_package} ) {
143 my $loaded = Class::MOP::is_class_loaded($exporting_package);
145 die "Package in also ($exporting_package) does not seem to "
146 . "use Moose::Exporter"
147 . ( $loaded ? "" : " (is it loaded?)" );
150 my $also = $EXPORT_SPEC{$exporting_package}{also};
152 return unless defined $also;
154 my @also = ref $also ? @{$also} : $also;
156 for my $package (@also) {
158 "Circular reference in 'also' parameter to Moose::Exporter between $exporting_package and $package"
159 if $seen->{$package};
161 $seen->{$package} = 1;
164 return @also, map { _follow_also_real($_) } @also;
168 sub _parse_trait_aliases {
170 my ($package, $aliases) = @_;
173 for my $alias (@$aliases) {
176 reftype($alias) eq 'ARRAY'
177 or Moose->throw_error(reftype($alias) . " references are not "
178 . "valid arguments to the 'trait_aliases' "
181 ($alias, $name) = @$alias;
184 ($name = $alias) =~ s/.*:://;
186 push @ret, subname "${package}::${name}" => sub () { $alias };
192 sub _make_sub_exporter_params {
194 my $packages = shift;
195 my $export_recorder = shift;
196 my $is_reexport = shift;
200 for my $package ( @{$packages} ) {
201 my $args = $EXPORT_SPEC{$package}
202 or die "The $package package does not use Moose::Exporter\n";
204 for my $name ( @{ $args->{with_meta} } ) {
205 my $sub = $class->_sub_from_package( $package, $name )
208 my $fq_name = $package . '::' . $name;
210 $exports{$name} = $class->_make_wrapped_sub_with_meta(
217 for my $name ( @{ $args->{with_caller} } ) {
218 my $sub = $class->_sub_from_package( $package, $name )
221 my $fq_name = $package . '::' . $name;
223 $exports{$name} = $class->_make_wrapped_sub(
230 my @extra_exports = $class->_parse_trait_aliases(
231 $package, $args->{trait_aliases},
233 for my $name ( @{ $args->{as_is} }, @extra_exports ) {
234 my ( $sub, $coderef_name );
240 ( $coderef_pkg, $coderef_name )
241 = Class::MOP::get_code_info($name);
243 if ( $coderef_pkg ne $package ) {
244 $is_reexport->{$coderef_name} = 1;
248 $sub = $class->_sub_from_package( $package, $name )
251 $coderef_name = $name;
254 $export_recorder->{$sub} = 1;
256 $exports{$coderef_name} = sub {$sub};
263 sub _sub_from_package {
270 \&{ $package . '::' . $name };
273 return $sub if defined &$sub;
275 Carp::cluck "Trying to export undefined sub ${package}::${name}";
282 sub _make_wrapped_sub {
286 my $export_recorder = shift;
288 # We need to set the package at import time, so that when
289 # package Foo imports has(), we capture "Foo" as the
290 # package. This lets other packages call Foo::has() and get
291 # the right package. This is done for backwards compatibility
292 # with existing production code, not because this is a good
295 my $caller = $CALLER;
297 my $wrapper = $self->_curry_wrapper( $sub, $fq_name, $caller );
299 my $sub = subname( $fq_name => $wrapper );
301 $export_recorder->{$sub} = 1;
307 sub _make_wrapped_sub_with_meta {
311 my $export_recorder = shift;
314 my $caller = $CALLER;
316 my $wrapper = $self->_late_curry_wrapper(
318 sub { Class::MOP::class_of(shift) } => $caller
321 my $sub = subname( $fq_name => $wrapper );
323 $export_recorder->{$sub} = 1;
335 my $wrapper = sub { $sub->( @extra, @_ ) };
336 if ( my $proto = prototype $sub ) {
338 # XXX - Perl's prototype sucks. Use & to make set_prototype
339 # ignore the fact that we're passing "private variables"
340 &Scalar::Util::set_prototype( $wrapper, $proto );
345 sub _late_curry_wrapper {
354 # resolve curried arguments at runtime via this closure
355 my @curry = ( $extra->(@ex_args) );
356 return $sub->( @curry, @_ );
359 if ( my $proto = prototype $sub ) {
361 # XXX - Perl's prototype sucks. Use & to make set_prototype
362 # ignore the fact that we're passing "private variables"
363 &Scalar::Util::set_prototype( $wrapper, $proto );
368 sub _make_import_sub {
370 my $exporting_package = shift;
371 my $exporter = shift;
372 my $exports_from = shift;
373 my $is_reexport = shift;
377 # I think we could use Sub::Exporter's collector feature
378 # to do this, but that would be rather gross, since that
379 # feature isn't really designed to return a value to the
380 # caller of the exporter sub.
382 # Also, this makes sure we preserve backwards compat for
383 # _get_caller, so it always sees the arguments in the
386 ( $traits, @_ ) = _strip_traits(@_);
389 ( $metaclass, @_ ) = _strip_metaclass(@_);
391 = Moose::Util::resolve_metaclass_alias( 'Class' => $metaclass )
392 if defined $metaclass && length $metaclass;
395 ( $meta_name, @_ ) = _strip_meta_name(@_);
397 # Normally we could look at $_[0], but in some weird cases
398 # (involving goto &Moose::import), $_[0] ends as something
399 # else (like Squirrel).
400 my $class = $exporting_package;
402 $CALLER = _get_caller(@_);
404 # this works because both pragmas set $^H (see perldoc
405 # perlvar) which affects the current compilation -
406 # i.e. the file who use'd us - which is why we don't need
407 # to do anything special to make it affect that file
408 # rather than this one (which is already compiled)
414 for my $c ( grep { $_->can('init_meta') } $class, @{$exports_from} ) {
416 # init_meta can apply a role, which when loaded uses
417 # Moose::Exporter, which in turn sets $CALLER, so we need
418 # to protect against that.
419 local $CALLER = $CALLER;
421 for_class => $CALLER,
422 metaclass => $metaclass,
423 meta_name => $meta_name,
428 if ( $did_init_meta && @{$traits} ) {
430 # The traits will use Moose::Role, which in turn uses
431 # Moose::Exporter, which in turn sets $CALLER, so we need
432 # to protect against that.
433 local $CALLER = $CALLER;
434 _apply_meta_traits( $CALLER, $traits );
436 elsif ( @{$traits} ) {
439 "Cannot provide traits when $class does not have an init_meta() method"
443 my ( undef, @args ) = @_;
444 my $extra = shift @args if ref $args[0] eq 'HASH';
447 if ( !$extra->{into} ) {
448 $extra->{into_level} ||= 0;
449 $extra->{into_level}++;
452 $class->$exporter( $extra, @args );
457 my $idx = first_index { ( $_ || '' ) eq '-traits' } @_;
459 return ( [], @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
461 my $traits = $_[ $idx + 1 ];
465 $traits = [$traits] unless ref $traits;
467 return ( $traits, @_ );
470 sub _strip_metaclass {
471 my $idx = first_index { ( $_ || '' ) eq '-metaclass' } @_;
473 return ( undef, @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
475 my $metaclass = $_[ $idx + 1 ];
479 return ( $metaclass, @_ );
482 sub _strip_meta_name {
483 my $idx = first_index { ( $_ || '' ) eq '-meta_name' } @_;
485 return ( 'meta', @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
487 my $meta_name = $_[ $idx + 1 ];
491 return ( $meta_name, @_ );
494 sub _apply_meta_traits {
495 my ( $class, $traits ) = @_;
497 return unless @{$traits};
499 my $meta = Class::MOP::class_of($class);
501 my $type = ( split /::/, ref $meta )[-1]
502 or Moose->throw_error(
503 'Cannot determine metaclass type for trait application . Meta isa '
506 my @resolved_traits = map {
509 : Moose::Util::resolve_metatrait_alias( $type => $_ )
512 return unless @resolved_traits;
514 my %args = ( for => $class );
516 if ( $meta->isa('Moose::Meta::Role') ) {
517 $args{role_metaroles} = { role => \@resolved_traits };
520 $args{class_metaroles} = { class => \@resolved_traits };
523 Moose::Util::MetaRole::apply_metaroles(%args);
528 # 1 extra level because it's called by import so there's a layer
533 ( ref $_[1] && defined $_[1]->{into} ) ? $_[1]->{into}
534 : ( ref $_[1] && defined $_[1]->{into_level} )
535 ? caller( $offset + $_[1]->{into_level} )
539 sub _make_unimport_sub {
541 my $exporting_package = shift;
543 my $export_recorder = shift;
544 my $is_reexport = shift;
547 my $caller = scalar caller();
548 Moose::Exporter->_remove_keywords(
550 [ keys %{$exports} ],
557 sub _remove_keywords {
560 my $keywords = shift;
561 my $recorded_exports = shift;
562 my $is_reexport = shift;
566 foreach my $name ( @{$keywords} ) {
567 if ( defined &{ $package . '::' . $name } ) {
568 my $sub = \&{ $package . '::' . $name };
570 # make sure it is from us
571 next unless $recorded_exports->{$sub};
573 if ( $is_reexport->{$name} ) {
576 unless _export_is_flagged(
577 \*{ join q{::} => $package, $name } );
580 # and if it is from us, then undef the slot
581 delete ${ $package . '::' }{$name};
586 sub _make_init_meta {
598 wrapped_method_metaclass
605 $old_style_roles{$role} = $args->{$role}
606 if exists $args->{$role};
609 my %base_class_roles;
610 %base_class_roles = ( roles => $args->{base_class_roles} )
611 if exists $args->{base_class_roles};
613 my %new_style_roles = map { $_ => $args->{$_} }
614 grep { exists $args->{$_} } qw( class_metaroles role_metaroles );
616 return unless %new_style_roles || %old_style_roles || %base_class_roles;
622 return unless Class::MOP::class_of( $options{for_class} );
624 if ( %new_style_roles || %old_style_roles ) {
625 Moose::Util::MetaRole::apply_metaroles(
626 for => $options{for_class},
632 Moose::Util::MetaRole::apply_base_class_roles(
633 for_class => $options{for_class},
636 if Class::MOP::class_of( $options{for_class} )
637 ->isa('Moose::Meta::Class');
639 return Class::MOP::class_of( $options{for_class} );
650 # ABSTRACT: make an import() and unimport() just like Moose.pm
656 package MyApp::Moose;
661 Moose::Exporter->setup_import_methods(
662 with_meta => [ 'has_rw', 'sugar2' ],
663 as_is => [ 'sugar3', \&Some::Random::thing ],
668 my ( $meta, $name, %options ) = @_;
669 $meta->add_attribute(
689 This module encapsulates the exporting of sugar functions in a
690 C<Moose.pm>-like manner. It does this by building custom C<import>,
691 C<unimport>, and C<init_meta> methods for your module, based on a spec you
694 It also lets you "stack" Moose-alike modules so you can export Moose's sugar
695 as well as your own, along with sugar from any random C<MooseX> module, as
696 long as they all use C<Moose::Exporter>. This feature exists to let you bundle
697 a set of MooseX modules into a policy module that developers can use directly
698 instead of using Moose itself.
700 To simplify writing exporter modules, C<Moose::Exporter> also imports
701 C<strict> and C<warnings> into your exporter module, as well as into
706 This module provides two public methods:
710 =item B<< Moose::Exporter->setup_import_methods(...) >>
712 When you call this method, C<Moose::Exporter> builds custom C<import>,
713 C<unimport>, and C<init_meta> methods for your module. The C<import> method
714 will export the functions you specify, and can also re-export functions
715 exported by some other module (like C<Moose.pm>).
717 The C<unimport> method cleans the caller's namespace of all the exported
718 functions. This includes any functions you re-export from other
719 packages. However, if the consumer of your package also imports those
720 functions from the original package, they will I<not> be cleaned.
722 If you pass any parameters for L<Moose::Util::MetaRole>, this method will
723 generate an C<init_meta> for you as well (see below for details). This
724 C<init_meta> will call C<Moose::Util::MetaRole::apply_metaroles> and
725 C<Moose::Util::MetaRole::apply_base_class_roles> as needed.
727 Note that if any of these methods already exist, they will not be
728 overridden, you will have to use C<build_import_methods> to get the
729 coderef that would be installed.
731 This method accepts the following parameters:
735 =item * with_meta => [ ... ]
737 This list of function I<names only> will be wrapped and then exported. The
738 wrapper will pass the metaclass object for the caller as its first argument.
740 Many sugar functions will need to use this metaclass object to do something to
743 =item * as_is => [ ... ]
745 This list of function names or sub references will be exported as-is. You can
746 identify a subroutine by reference, which is handy to re-export some other
747 module's functions directly by reference (C<\&Some::Package::function>).
749 If you do export some other package's function, this function will never be
750 removed by the C<unimport> method. The reason for this is we cannot know if
751 the caller I<also> explicitly imported the sub themselves, and therefore wants
754 =item * trait_aliases => [ ... ]
756 This is a list of package names which should have shortened aliases exported,
757 similar to the functionality of L<aliased>. Each element in the list can be
758 either a package name, in which case the export will be named as the last
759 namespace component of the package, or an arrayref, whose first element is the
760 package to alias to, and second element is the alias to export.
762 =item * also => $name or \@names
764 This is a list of modules which contain functions that the caller
765 wants to export. These modules must also use C<Moose::Exporter>. The
766 most common use case will be to export the functions from C<Moose.pm>.
767 Functions specified by C<with_meta> or C<as_is> take precedence over
768 functions exported by modules specified by C<also>, so that a module
769 can selectively override functions exported by another module.
771 C<Moose::Exporter> also makes sure all these functions get removed
772 when C<unimport> is called.
776 You can also provide parameters for C<Moose::Util::MetaRole::apply_metaroles>
777 and C<Moose::Util::MetaRole::base_class_roles>. Specifically, valid parameters
778 are "class_metaroles", "role_metaroles", and "base_class_roles".
780 =item B<< Moose::Exporter->build_import_methods(...) >>
782 Returns two or three code refs, one for C<import>, one for
783 C<unimport>, and optionally one for C<init_meta>, if the appropriate
784 options are passed in.
786 Accepts the additional C<install> option, which accepts an arrayref of method
787 names to install into your exporting package. The valid options are C<import>,
788 C<unimport>, and C<init_meta>. Calling C<setup_import_methods> is equivalent
789 to calling C<build_import_methods> with C<< install => [qw(import unimport
790 init_meta)] >> except that it doesn't also return the methods.
792 Used by C<setup_import_methods>.
796 =head1 IMPORTING AND init_meta
798 If you want to set an alternative base object class or metaclass class, see
799 above for details on how this module can call L<Moose::Util::MetaRole> for
802 If you want to do something that is not supported by this module, simply
803 define an C<init_meta> method in your class. The C<import> method that
804 C<Moose::Exporter> generates for you will call this method (if it exists). It
805 will always pass the caller to this method via the C<for_class> parameter.
807 Most of the time, your C<init_meta> method will probably just call C<<
808 Moose->init_meta >> to do the real work:
811 shift; # our class name
812 return Moose->init_meta( @_, metaclass => 'My::Metaclass' );
815 Keep in mind that C<build_import_methods> will return an C<init_meta>
816 method for you, which you can also call from within your custom
819 my ( $import, $unimport, $init_meta ) =
820 Moose::Exporter->build_import_methods( ... );
827 $class->$import(...);
832 sub unimport { goto &$unimport }
839 $class->$init_meta(...);
844 =head1 METACLASS TRAITS
846 The C<import> method generated by C<Moose::Exporter> will allow the
847 user of your module to specify metaclass traits in a C<-traits>
848 parameter passed as part of the import:
850 use Moose -traits => 'My::Meta::Trait';
852 use Moose -traits => [ 'My::Meta::Trait', 'My::Other::Trait' ];
854 These traits will be applied to the caller's metaclass
855 instance. Providing traits for an exporting class that does not create
856 a metaclass for the caller is an error.
860 See L<Moose/BUGS> for details on reporting bugs.