1 package Moose::Exporter;
6 our $AUTHORITY = 'cpan:STEVAN';
13 $Moose::{VERSION} ? $Moose::{VERSION} : ()
18 use List::MoreUtils qw( first_index uniq );
19 use Moose::Util::MetaRole;
20 use Scalar::Util qw(reftype);
21 use Sub::Exporter 0.980;
22 use Sub::Name qw(subname);
26 sub setup_import_methods {
27 my ( $class, %args ) = @_;
29 my $exporting_package = $args{exporting_package} ||= caller();
31 $class->build_import_methods(
33 install => [qw(import unimport init_meta)]
37 sub build_import_methods {
38 my ( $class, %args ) = @_;
40 my $exporting_package = $args{exporting_package} ||= caller();
42 $EXPORT_SPEC{$exporting_package} = \%args;
44 my @exports_from = $class->_follow_also($exporting_package);
46 my $export_recorder = {};
49 my $exports = $class->_make_sub_exporter_params(
50 [ @exports_from, $exporting_package ],
55 my $exporter = $class->_make_exporter($exports, $is_reexport);
58 $methods{import} = $class->_make_import_sub(
65 $methods{unimport} = $class->_make_unimport_sub(
72 $methods{init_meta} = $class->_make_init_meta(
77 my $package = Class::MOP::Package->initialize($exporting_package);
78 for my $to_install ( @{ $args{install} || [] } ) {
79 my $symbol = '&' . $to_install;
81 unless $methods{$to_install}
82 && !$package->has_package_symbol($symbol);
83 $package->add_package_symbol( $symbol, $methods{$to_install} );
86 return ( $methods{import}, $methods{unimport}, $methods{init_meta} );
90 my ($class, $exports, $is_reexport) = @_;
92 return Sub::Exporter::build_exporter(
95 groups => { default => [':all'] },
97 my ($arg, $to_export) = @_;
98 my $meta = Class::MOP::class_of($arg->{into});
100 goto &Sub::Exporter::default_installer unless $meta;
102 # don't overwrite existing symbols with our magically flagged
103 # version of it if we would install the same sub that's already
106 my @filtered_to_export;
108 for (my $i = 0; $i < @{ $to_export }; $i += 2) {
109 my ($as, $cv) = @{ $to_export }[$i, $i + 1];
112 && $meta->has_package_symbol('&' . $as)
113 && $meta->get_package_symbol('&' . $as) == $cv;
115 push @filtered_to_export, $as, $cv;
116 $installed{$as} = 1 unless ref $as;
119 Sub::Exporter::default_installer($arg, \@filtered_to_export);
121 for my $name ( keys %{$is_reexport} ) {
124 next unless exists $installed{$name};
125 _flag_as_reexport( \*{ join q{::}, $arg->{into}, $name } );
137 my $exporting_package = shift;
139 local %$seen = ( $exporting_package => 1 );
141 return uniq( _follow_also_real($exporting_package) );
144 sub _follow_also_real {
145 my $exporting_package = shift;
147 if ( !exists $EXPORT_SPEC{$exporting_package} ) {
148 my $loaded = Class::MOP::is_class_loaded($exporting_package);
150 die "Package in also ($exporting_package) does not seem to "
151 . "use Moose::Exporter"
152 . ( $loaded ? "" : " (is it loaded?)" );
155 my $also = $EXPORT_SPEC{$exporting_package}{also};
157 return unless defined $also;
159 my @also = ref $also ? @{$also} : $also;
161 for my $package (@also) {
163 "Circular reference in 'also' parameter to Moose::Exporter between $exporting_package and $package"
164 if $seen->{$package};
166 $seen->{$package} = 1;
169 return @also, map { _follow_also_real($_) } @also;
173 sub _parse_trait_aliases {
175 my ($package, $aliases) = @_;
178 for my $alias (@$aliases) {
181 reftype($alias) eq 'ARRAY'
182 or Moose->throw_error(reftype($alias) . " references are not "
183 . "valid arguments to the 'trait_aliases' "
186 ($alias, $name) = @$alias;
189 ($name = $alias) =~ s/.*:://;
191 push @ret, subname "${package}::${name}" => sub () { $alias };
197 sub _make_sub_exporter_params {
199 my $packages = shift;
200 my $export_recorder = shift;
201 my $is_reexport = shift;
205 for my $package ( @{$packages} ) {
206 my $args = $EXPORT_SPEC{$package}
207 or die "The $package package does not use Moose::Exporter\n";
209 for my $name ( @{ $args->{with_meta} } ) {
210 my $sub = $class->_sub_from_package( $package, $name )
213 my $fq_name = $package . '::' . $name;
215 $exports{$name} = $class->_make_wrapped_sub_with_meta(
222 for my $name ( @{ $args->{with_caller} } ) {
223 my $sub = $class->_sub_from_package( $package, $name )
226 my $fq_name = $package . '::' . $name;
228 $exports{$name} = $class->_make_wrapped_sub(
235 my @extra_exports = $class->_parse_trait_aliases(
236 $package, $args->{trait_aliases},
238 for my $name ( @{ $args->{as_is} }, @extra_exports ) {
239 my ( $sub, $coderef_name );
245 ( $coderef_pkg, $coderef_name )
246 = Class::MOP::get_code_info($name);
248 if ( $coderef_pkg ne $package ) {
249 $is_reexport->{$coderef_name} = 1;
253 $sub = $class->_sub_from_package( $package, $name )
256 $coderef_name = $name;
259 $export_recorder->{$sub} = 1;
261 $exports{$coderef_name} = sub {$sub};
268 sub _sub_from_package {
275 \&{ $package . '::' . $name };
278 return $sub if defined &$sub;
280 Carp::cluck "Trying to export undefined sub ${package}::${name}";
287 sub _make_wrapped_sub {
291 my $export_recorder = shift;
293 # We need to set the package at import time, so that when
294 # package Foo imports has(), we capture "Foo" as the
295 # package. This lets other packages call Foo::has() and get
296 # the right package. This is done for backwards compatibility
297 # with existing production code, not because this is a good
300 my $caller = $CALLER;
302 my $wrapper = $self->_curry_wrapper( $sub, $fq_name, $caller );
304 my $sub = subname( $fq_name => $wrapper );
306 $export_recorder->{$sub} = 1;
312 sub _make_wrapped_sub_with_meta {
316 my $export_recorder = shift;
319 my $caller = $CALLER;
321 my $wrapper = $self->_late_curry_wrapper(
323 sub { Class::MOP::class_of(shift) } => $caller
326 my $sub = subname( $fq_name => $wrapper );
328 $export_recorder->{$sub} = 1;
340 my $wrapper = sub { $sub->( @extra, @_ ) };
341 if ( my $proto = prototype $sub ) {
343 # XXX - Perl's prototype sucks. Use & to make set_prototype
344 # ignore the fact that we're passing "private variables"
345 &Scalar::Util::set_prototype( $wrapper, $proto );
350 sub _late_curry_wrapper {
359 # resolve curried arguments at runtime via this closure
360 my @curry = ( $extra->(@ex_args) );
361 return $sub->( @curry, @_ );
364 if ( my $proto = prototype $sub ) {
366 # XXX - Perl's prototype sucks. Use & to make set_prototype
367 # ignore the fact that we're passing "private variables"
368 &Scalar::Util::set_prototype( $wrapper, $proto );
373 sub _make_import_sub {
375 my $exporting_package = shift;
376 my $exporter = shift;
377 my $exports_from = shift;
378 my $is_reexport = shift;
382 # I think we could use Sub::Exporter's collector feature
383 # to do this, but that would be rather gross, since that
384 # feature isn't really designed to return a value to the
385 # caller of the exporter sub.
387 # Also, this makes sure we preserve backwards compat for
388 # _get_caller, so it always sees the arguments in the
391 ( $traits, @_ ) = _strip_traits(@_);
394 ( $metaclass, @_ ) = _strip_metaclass(@_);
396 = Moose::Util::resolve_metaclass_alias( 'Class' => $metaclass )
397 if defined $metaclass && length $metaclass;
400 ( $meta_name, @_ ) = _strip_meta_name(@_);
402 # Normally we could look at $_[0], but in some weird cases
403 # (involving goto &Moose::import), $_[0] ends as something
404 # else (like Squirrel).
405 my $class = $exporting_package;
407 $CALLER = _get_caller(@_);
409 # this works because both pragmas set $^H (see perldoc
410 # perlvar) which affects the current compilation -
411 # i.e. the file who use'd us - which is why we don't need
412 # to do anything special to make it affect that file
413 # rather than this one (which is already compiled)
419 for my $c ( grep { $_->can('init_meta') } $class, @{$exports_from} ) {
421 # init_meta can apply a role, which when loaded uses
422 # Moose::Exporter, which in turn sets $CALLER, so we need
423 # to protect against that.
424 local $CALLER = $CALLER;
426 for_class => $CALLER,
427 metaclass => $metaclass,
428 meta_name => $meta_name,
433 if ( $did_init_meta && @{$traits} ) {
435 # The traits will use Moose::Role, which in turn uses
436 # Moose::Exporter, which in turn sets $CALLER, so we need
437 # to protect against that.
438 local $CALLER = $CALLER;
439 _apply_meta_traits( $CALLER, $traits );
441 elsif ( @{$traits} ) {
444 "Cannot provide traits when $class does not have an init_meta() method"
448 my ( undef, @args ) = @_;
449 my $extra = shift @args if ref $args[0] eq 'HASH';
452 if ( !$extra->{into} ) {
453 $extra->{into_level} ||= 0;
454 $extra->{into_level}++;
457 $class->$exporter( $extra, @args );
462 my $idx = first_index { ( $_ || '' ) eq '-traits' } @_;
464 return ( [], @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
466 my $traits = $_[ $idx + 1 ];
470 $traits = [$traits] unless ref $traits;
472 return ( $traits, @_ );
475 sub _strip_metaclass {
476 my $idx = first_index { ( $_ || '' ) eq '-metaclass' } @_;
478 return ( undef, @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
480 my $metaclass = $_[ $idx + 1 ];
484 return ( $metaclass, @_ );
487 sub _strip_meta_name {
488 my $idx = first_index { ( $_ || '' ) eq '-meta_name' } @_;
490 return ( 'meta', @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
492 my $meta_name = $_[ $idx + 1 ];
496 return ( $meta_name, @_ );
499 sub _apply_meta_traits {
500 my ( $class, $traits ) = @_;
502 return unless @{$traits};
504 my $meta = Class::MOP::class_of($class);
506 my $type = ( split /::/, ref $meta )[-1]
507 or Moose->throw_error(
508 'Cannot determine metaclass type for trait application . Meta isa '
511 my @resolved_traits = map {
514 : Moose::Util::resolve_metatrait_alias( $type => $_ )
517 return unless @resolved_traits;
519 my %args = ( for => $class );
521 if ( $meta->isa('Moose::Meta::Role') ) {
522 $args{role_metaroles} = { role => \@resolved_traits };
525 $args{class_metaroles} = { class => \@resolved_traits };
528 Moose::Util::MetaRole::apply_metaroles(%args);
533 # 1 extra level because it's called by import so there's a layer
538 ( ref $_[1] && defined $_[1]->{into} ) ? $_[1]->{into}
539 : ( ref $_[1] && defined $_[1]->{into_level} )
540 ? caller( $offset + $_[1]->{into_level} )
544 sub _make_unimport_sub {
546 my $exporting_package = shift;
548 my $export_recorder = shift;
549 my $is_reexport = shift;
552 my $caller = scalar caller();
553 Moose::Exporter->_remove_keywords(
555 [ keys %{$exports} ],
562 sub _remove_keywords {
565 my $keywords = shift;
566 my $recorded_exports = shift;
567 my $is_reexport = shift;
571 foreach my $name ( @{$keywords} ) {
572 if ( defined &{ $package . '::' . $name } ) {
573 my $sub = \&{ $package . '::' . $name };
575 # make sure it is from us
576 next unless $recorded_exports->{$sub};
578 if ( $is_reexport->{$name} ) {
581 unless _export_is_flagged(
582 \*{ join q{::} => $package, $name } );
585 # and if it is from us, then undef the slot
586 delete ${ $package . '::' }{$name};
591 sub _make_init_meta {
603 wrapped_method_metaclass
610 $old_style_roles{$role} = $args->{$role}
611 if exists $args->{$role};
614 my %base_class_roles;
615 %base_class_roles = ( roles => $args->{base_class_roles} )
616 if exists $args->{base_class_roles};
618 my %new_style_roles = map { $_ => $args->{$_} }
619 grep { exists $args->{$_} } qw( class_metaroles role_metaroles );
621 return unless %new_style_roles || %old_style_roles || %base_class_roles;
627 return unless Class::MOP::class_of( $options{for_class} );
629 if ( %new_style_roles || %old_style_roles ) {
630 Moose::Util::MetaRole::apply_metaroles(
631 for => $options{for_class},
637 Moose::Util::MetaRole::apply_base_class_roles(
638 for_class => $options{for_class},
641 if Class::MOP::class_of( $options{for_class} )
642 ->isa('Moose::Meta::Class');
644 return Class::MOP::class_of( $options{for_class} );
655 # ABSTRACT: make an import() and unimport() just like Moose.pm
661 package MyApp::Moose;
666 Moose::Exporter->setup_import_methods(
667 with_meta => [ 'has_rw', 'sugar2' ],
668 as_is => [ 'sugar3', \&Some::Random::thing ],
673 my ( $meta, $name, %options ) = @_;
674 $meta->add_attribute(
694 This module encapsulates the exporting of sugar functions in a
695 C<Moose.pm>-like manner. It does this by building custom C<import>,
696 C<unimport>, and C<init_meta> methods for your module, based on a spec you
699 It also lets you "stack" Moose-alike modules so you can export Moose's sugar
700 as well as your own, along with sugar from any random C<MooseX> module, as
701 long as they all use C<Moose::Exporter>. This feature exists to let you bundle
702 a set of MooseX modules into a policy module that developers can use directly
703 instead of using Moose itself.
705 To simplify writing exporter modules, C<Moose::Exporter> also imports
706 C<strict> and C<warnings> into your exporter module, as well as into
711 This module provides two public methods:
715 =item B<< Moose::Exporter->setup_import_methods(...) >>
717 When you call this method, C<Moose::Exporter> builds custom C<import>,
718 C<unimport>, and C<init_meta> methods for your module. The C<import> method
719 will export the functions you specify, and can also re-export functions
720 exported by some other module (like C<Moose.pm>).
722 The C<unimport> method cleans the caller's namespace of all the exported
723 functions. This includes any functions you re-export from other
724 packages. However, if the consumer of your package also imports those
725 functions from the original package, they will I<not> be cleaned.
727 If you pass any parameters for L<Moose::Util::MetaRole>, this method will
728 generate an C<init_meta> for you as well (see below for details). This
729 C<init_meta> will call C<Moose::Util::MetaRole::apply_metaroles> and
730 C<Moose::Util::MetaRole::apply_base_class_roles> as needed.
732 Note that if any of these methods already exist, they will not be
733 overridden, you will have to use C<build_import_methods> to get the
734 coderef that would be installed.
736 This method accepts the following parameters:
740 =item * with_meta => [ ... ]
742 This list of function I<names only> will be wrapped and then exported. The
743 wrapper will pass the metaclass object for the caller as its first argument.
745 Many sugar functions will need to use this metaclass object to do something to
748 =item * as_is => [ ... ]
750 This list of function names or sub references will be exported as-is. You can
751 identify a subroutine by reference, which is handy to re-export some other
752 module's functions directly by reference (C<\&Some::Package::function>).
754 If you do export some other package's function, this function will never be
755 removed by the C<unimport> method. The reason for this is we cannot know if
756 the caller I<also> explicitly imported the sub themselves, and therefore wants
759 =item * trait_aliases => [ ... ]
761 This is a list of package names which should have shortened aliases exported,
762 similar to the functionality of L<aliased>. Each element in the list can be
763 either a package name, in which case the export will be named as the last
764 namespace component of the package, or an arrayref, whose first element is the
765 package to alias to, and second element is the alias to export.
767 =item * also => $name or \@names
769 This is a list of modules which contain functions that the caller
770 wants to export. These modules must also use C<Moose::Exporter>. The
771 most common use case will be to export the functions from C<Moose.pm>.
772 Functions specified by C<with_meta> or C<as_is> take precedence over
773 functions exported by modules specified by C<also>, so that a module
774 can selectively override functions exported by another module.
776 C<Moose::Exporter> also makes sure all these functions get removed
777 when C<unimport> is called.
781 You can also provide parameters for C<Moose::Util::MetaRole::apply_metaroles>
782 and C<Moose::Util::MetaRole::base_class_roles>. Specifically, valid parameters
783 are "class_metaroles", "role_metaroles", and "base_class_roles".
785 =item B<< Moose::Exporter->build_import_methods(...) >>
787 Returns two or three code refs, one for C<import>, one for
788 C<unimport>, and optionally one for C<init_meta>, if the appropriate
789 options are passed in.
791 Accepts the additional C<install> option, which accepts an arrayref of method
792 names to install into your exporting package. The valid options are C<import>,
793 C<unimport>, and C<init_meta>. Calling C<setup_import_methods> is equivalent
794 to calling C<build_import_methods> with C<< install => [qw(import unimport
795 init_meta)] >> except that it doesn't also return the methods.
797 Used by C<setup_import_methods>.
801 =head1 IMPORTING AND init_meta
803 If you want to set an alternative base object class or metaclass class, see
804 above for details on how this module can call L<Moose::Util::MetaRole> for
807 If you want to do something that is not supported by this module, simply
808 define an C<init_meta> method in your class. The C<import> method that
809 C<Moose::Exporter> generates for you will call this method (if it exists). It
810 will always pass the caller to this method via the C<for_class> parameter.
812 Most of the time, your C<init_meta> method will probably just call C<<
813 Moose->init_meta >> to do the real work:
816 shift; # our class name
817 return Moose->init_meta( @_, metaclass => 'My::Metaclass' );
820 Keep in mind that C<build_import_methods> will return an C<init_meta>
821 method for you, which you can also call from within your custom
824 my ( $import, $unimport, $init_meta ) =
825 Moose::Exporter->build_import_methods( ... );
832 $class->$import(...);
837 sub unimport { goto &$unimport }
844 $class->$init_meta(...);
849 =head1 METACLASS TRAITS
851 The C<import> method generated by C<Moose::Exporter> will allow the
852 user of your module to specify metaclass traits in a C<-traits>
853 parameter passed as part of the import:
855 use Moose -traits => 'My::Meta::Trait';
857 use Moose -traits => [ 'My::Meta::Trait', 'My::Other::Trait' ];
859 These traits will be applied to the caller's metaclass
860 instance. Providing traits for an exporting class that does not create
861 a metaclass for the caller is an error.
865 See L<Moose/BUGS> for details on reporting bugs.