1 package Moose::Exporter;
7 our $XS_VERSION = $VERSION;
8 $VERSION = eval $VERSION;
9 our $AUTHORITY = 'cpan:STEVAN';
12 use List::MoreUtils qw( first_index uniq );
13 use Moose::Deprecated;
14 use Moose::Util::MetaRole;
15 use Scalar::Util qw(reftype);
16 use Sub::Exporter 0.980;
17 use Sub::Name qw(subname);
21 XSLoader::load( 'Moose', $XS_VERSION );
25 sub setup_import_methods {
26 my ( $class, %args ) = @_;
28 my $exporting_package = $args{exporting_package} ||= caller();
30 $class->build_import_methods(
32 install => [qw(import unimport init_meta)]
36 sub build_import_methods {
37 my ( $class, %args ) = @_;
39 my $exporting_package = $args{exporting_package} ||= caller();
41 $EXPORT_SPEC{$exporting_package} = \%args;
43 my @exports_from = $class->_follow_also($exporting_package);
45 my $export_recorder = {};
48 my $exports = $class->_make_sub_exporter_params(
49 [ @exports_from, $exporting_package ],
54 my $exporter = Sub::Exporter::build_exporter(
57 groups => { default => [':all'] }
62 $methods{import} = $class->_make_import_sub(
69 $methods{unimport} = $class->_make_unimport_sub(
76 $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} );
98 my $exporting_package = shift;
100 local %$seen = ( $exporting_package => 1 );
102 return uniq( _follow_also_real($exporting_package) );
105 sub _follow_also_real {
106 my $exporting_package = shift;
108 if ( !exists $EXPORT_SPEC{$exporting_package} ) {
109 my $loaded = Class::MOP::is_class_loaded($exporting_package);
111 die "Package in also ($exporting_package) does not seem to "
112 . "use Moose::Exporter"
113 . ( $loaded ? "" : " (is it loaded?)" );
116 my $also = $EXPORT_SPEC{$exporting_package}{also};
118 return unless defined $also;
120 my @also = ref $also ? @{$also} : $also;
122 for my $package (@also) {
124 "Circular reference in 'also' parameter to Moose::Exporter between $exporting_package and $package"
125 if $seen->{$package};
127 $seen->{$package} = 1;
130 return @also, map { _follow_also_real($_) } @also;
134 sub _parse_trait_aliases {
136 my ($package, $aliases) = @_;
139 for my $alias (@$aliases) {
142 reftype($alias) eq 'ARRAY'
143 or Moose->throw_error(reftype($alias) . " references are not "
144 . "valid arguments to the 'trait_aliases' "
147 ($alias, $name) = @$alias;
150 ($name = $alias) =~ s/.*:://;
152 push @ret, subname "${package}::${name}" => sub () { $alias };
158 sub _make_sub_exporter_params {
160 my $packages = shift;
161 my $export_recorder = shift;
162 my $is_reexport = shift;
166 for my $package ( @{$packages} ) {
167 my $args = $EXPORT_SPEC{$package}
168 or die "The $package package does not use Moose::Exporter\n";
170 for my $name ( @{ $args->{with_meta} } ) {
171 my $sub = $class->_sub_from_package( $package, $name )
174 my $fq_name = $package . '::' . $name;
176 $exports{$name} = $class->_make_wrapped_sub_with_meta(
183 for my $name ( @{ $args->{with_caller} } ) {
184 my $sub = $class->_sub_from_package( $package, $name )
187 my $fq_name = $package . '::' . $name;
189 $exports{$name} = $class->_make_wrapped_sub(
196 my @extra_exports = $class->_parse_trait_aliases(
197 $package, $args->{trait_aliases},
199 for my $name ( @{ $args->{as_is} }, @extra_exports ) {
200 my ( $sub, $coderef_name );
206 ( $coderef_pkg, $coderef_name )
207 = Class::MOP::get_code_info($name);
209 if ( $coderef_pkg ne $package ) {
210 $is_reexport->{$coderef_name} = 1;
214 $sub = $class->_sub_from_package( $package, $name )
217 $coderef_name = $name;
220 $export_recorder->{$sub} = 1;
222 $exports{$coderef_name} = sub {$sub};
229 sub _sub_from_package {
236 \&{ $package . '::' . $name };
239 return $sub if defined &$sub;
241 Carp::cluck "Trying to export undefined sub ${package}::${name}";
248 sub _make_wrapped_sub {
252 my $export_recorder = shift;
254 # We need to set the package at import time, so that when
255 # package Foo imports has(), we capture "Foo" as the
256 # package. This lets other packages call Foo::has() and get
257 # the right package. This is done for backwards compatibility
258 # with existing production code, not because this is a good
261 my $caller = $CALLER;
263 my $wrapper = $self->_curry_wrapper( $sub, $fq_name, $caller );
265 my $sub = subname( $fq_name => $wrapper );
267 $export_recorder->{$sub} = 1;
273 sub _make_wrapped_sub_with_meta {
277 my $export_recorder = shift;
280 my $caller = $CALLER;
282 my $wrapper = $self->_late_curry_wrapper(
284 sub { Class::MOP::class_of(shift) } => $caller
287 my $sub = subname( $fq_name => $wrapper );
289 $export_recorder->{$sub} = 1;
301 my $wrapper = sub { $sub->( @extra, @_ ) };
302 if ( my $proto = prototype $sub ) {
304 # XXX - Perl's prototype sucks. Use & to make set_prototype
305 # ignore the fact that we're passing "private variables"
306 &Scalar::Util::set_prototype( $wrapper, $proto );
311 sub _late_curry_wrapper {
320 # resolve curried arguments at runtime via this closure
321 my @curry = ( $extra->(@ex_args) );
322 return $sub->( @curry, @_ );
325 if ( my $proto = prototype $sub ) {
327 # XXX - Perl's prototype sucks. Use & to make set_prototype
328 # ignore the fact that we're passing "private variables"
329 &Scalar::Util::set_prototype( $wrapper, $proto );
334 sub _make_import_sub {
336 my $exporting_package = shift;
337 my $exporter = shift;
338 my $exports_from = shift;
339 my $is_reexport = shift;
343 # I think we could use Sub::Exporter's collector feature
344 # to do this, but that would be rather gross, since that
345 # feature isn't really designed to return a value to the
346 # caller of the exporter sub.
348 # Also, this makes sure we preserve backwards compat for
349 # _get_caller, so it always sees the arguments in the
352 ( $traits, @_ ) = _strip_traits(@_);
355 ( $metaclass, @_ ) = _strip_metaclass(@_);
357 = Moose::Util::resolve_metaclass_alias( 'Class' => $metaclass )
358 if defined $metaclass && length $metaclass;
360 # Normally we could look at $_[0], but in some weird cases
361 # (involving goto &Moose::import), $_[0] ends as something
362 # else (like Squirrel).
363 my $class = $exporting_package;
365 $CALLER = _get_caller(@_);
367 # this works because both pragmas set $^H (see perldoc
368 # perlvar) which affects the current compilation -
369 # i.e. the file who use'd us - which is why we don't need
370 # to do anything special to make it affect that file
371 # rather than this one (which is already compiled)
377 for my $c ( grep { $_->can('init_meta') } $class, @{$exports_from} ) {
379 # init_meta can apply a role, which when loaded uses
380 # Moose::Exporter, which in turn sets $CALLER, so we need
381 # to protect against that.
382 local $CALLER = $CALLER;
383 $c->init_meta( for_class => $CALLER, metaclass => $metaclass );
387 if ( $did_init_meta && @{$traits} ) {
389 # The traits will use Moose::Role, which in turn uses
390 # Moose::Exporter, which in turn sets $CALLER, so we need
391 # to protect against that.
392 local $CALLER = $CALLER;
393 _apply_meta_traits( $CALLER, $traits );
395 elsif ( @{$traits} ) {
398 "Cannot provide traits when $class does not have an init_meta() method"
402 my ( undef, @args ) = @_;
403 my $extra = shift @args if ref $args[0] eq 'HASH';
406 if ( !$extra->{into} ) {
407 $extra->{into_level} ||= 0;
408 $extra->{into_level}++;
411 $class->$exporter( $extra, @args );
413 for my $name ( keys %{$is_reexport} ) {
416 _flag_as_reexport( \*{ join q{::}, $CALLER, $name } );
422 my $idx = first_index { $_ eq '-traits' } @_;
424 return ( [], @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
426 my $traits = $_[ $idx + 1 ];
430 $traits = [$traits] unless ref $traits;
432 return ( $traits, @_ );
435 sub _strip_metaclass {
436 my $idx = first_index { $_ eq '-metaclass' } @_;
438 return ( undef, @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
440 my $metaclass = $_[ $idx + 1 ];
444 return ( $metaclass, @_ );
447 sub _apply_meta_traits {
448 my ( $class, $traits ) = @_;
450 return unless @{$traits};
452 my $meta = Class::MOP::class_of($class);
454 my $type = ( split /::/, ref $meta )[-1]
455 or Moose->throw_error(
456 'Cannot determine metaclass type for trait application . Meta isa '
459 my @resolved_traits = map {
462 : Moose::Util::resolve_metatrait_alias( $type => $_ )
465 return unless @resolved_traits;
467 my %args = ( for => $class );
469 if ( $meta->isa('Moose::Meta::Role') ) {
470 $args{role_metaroles} = { role => \@resolved_traits };
473 $args{class_metaroles} = { class => \@resolved_traits };
476 Moose::Util::MetaRole::apply_metaroles(%args);
481 # 1 extra level because it's called by import so there's a layer
486 ( ref $_[1] && defined $_[1]->{into} ) ? $_[1]->{into}
487 : ( ref $_[1] && defined $_[1]->{into_level} )
488 ? caller( $offset + $_[1]->{into_level} )
492 sub _make_unimport_sub {
494 my $exporting_package = shift;
496 my $export_recorder = shift;
497 my $is_reexport = shift;
500 my $caller = scalar caller();
501 Moose::Exporter->_remove_keywords(
503 [ keys %{$exports} ],
510 sub _remove_keywords {
513 my $keywords = shift;
514 my $recorded_exports = shift;
515 my $is_reexport = shift;
519 foreach my $name ( @{$keywords} ) {
520 if ( defined &{ $package . '::' . $name } ) {
521 my $sub = \&{ $package . '::' . $name };
523 # make sure it is from us
524 next unless $recorded_exports->{$sub};
526 if ( $is_reexport->{$name} ) {
529 unless _export_is_flagged(
530 \*{ join q{::} => $package, $name } );
533 # and if it is from us, then undef the slot
534 delete ${ $package . '::' }{$name};
539 sub _make_init_meta {
551 wrapped_method_metaclass
558 $old_style_roles{$role} = $args->{$role}
559 if exists $args->{$role};
562 my %base_class_roles;
563 %base_class_roles = ( roles => $args->{base_class_roles} )
564 if exists $args->{base_class_roles};
566 my %new_style_roles = map { $_ => $args->{$_} }
567 grep { exists $args->{$_} } qw( class_metaroles role_metaroles );
569 return unless %new_style_roles || %old_style_roles || %base_class_roles;
575 return unless Class::MOP::class_of( $options{for_class} );
577 if ( %new_style_roles || %old_style_roles ) {
578 Moose::Util::MetaRole::apply_metaroles(
579 for => $options{for_class},
585 Moose::Util::MetaRole::apply_base_class_roles(
586 for_class => $options{for_class},
589 if Class::MOP::class_of( $options{for_class} )
590 ->isa('Moose::Meta::Class');
592 return Class::MOP::class_of( $options{for_class} );
607 Moose::Exporter - make an import() and unimport() just like Moose.pm
611 package MyApp::Moose;
616 Moose::Exporter->setup_import_methods(
617 with_meta => [ 'has_rw', 'sugar2' ],
618 as_is => [ 'sugar3', \&Some::Random::thing ],
623 my ( $meta, $name, %options ) = @_;
624 $meta->add_attribute(
644 This module encapsulates the exporting of sugar functions in a
645 C<Moose.pm>-like manner. It does this by building custom C<import>,
646 C<unimport>, and C<init_meta> methods for your module, based on a spec you
649 It also lets you "stack" Moose-alike modules so you can export Moose's sugar
650 as well as your own, along with sugar from any random C<MooseX> module, as
651 long as they all use C<Moose::Exporter>. This feature exists to let you bundle
652 a set of MooseX modules into a policy module that developers can use directly
653 instead of using Moose itself.
655 To simplify writing exporter modules, C<Moose::Exporter> also imports
656 C<strict> and C<warnings> into your exporter module, as well as into
661 This module provides two public methods:
665 =item B<< Moose::Exporter->setup_import_methods(...) >>
667 When you call this method, C<Moose::Exporter> builds custom C<import>,
668 C<unimport>, and C<init_meta> methods for your module. The C<import> method
669 will export the functions you specify, and can also re-export functions
670 exported by some other module (like C<Moose.pm>).
672 The C<unimport> method cleans the caller's namespace of all the exported
673 functions. This includes any functions you re-export from other
674 packages. However, if the consumer of your package also imports those
675 functions from the original package, they will I<not> be cleaned.
677 If you pass any parameters for L<Moose::Util::MetaRole>, this method will
678 generate an C<init_meta> for you as well (see below for details). This
679 C<init_meta> will call C<Moose::Util::MetaRole::apply_metaroles> and
680 C<Moose::Util::MetaRole::apply_base_class_roles> as needed.
682 Note that if any of these methods already exist, they will not be
683 overridden, you will have to use C<build_import_methods> to get the
684 coderef that would be installed.
686 This method accepts the following parameters:
690 =item * with_meta => [ ... ]
692 This list of function I<names only> will be wrapped and then exported. The
693 wrapper will pass the metaclass object for the caller as its first argument.
695 Many sugar functions will need to use this metaclass object to do something to
698 =item * as_is => [ ... ]
700 This list of function names or sub references will be exported as-is. You can
701 identify a subroutine by reference, which is handy to re-export some other
702 module's functions directly by reference (C<\&Some::Package::function>).
704 If you do export some other package's function, this function will never be
705 removed by the C<unimport> method. The reason for this is we cannot know if
706 the caller I<also> explicitly imported the sub themselves, and therefore wants
709 =item * trait_aliases => [ ... ]
711 This is a list of package names which should have shortened alias exported,
712 similar to the functionality of L<aliased>. Each element in the list can be
713 either a package name, in which case the export will be named as the last
714 namespace component of the package, or an arrayref, whose first element is the
715 package to alias to, and second element is the alias to export.
717 =item * also => $name or \@names
719 This is a list of modules which contain functions that the caller
720 wants to export. These modules must also use C<Moose::Exporter>. The
721 most common use case will be to export the functions from C<Moose.pm>.
722 Functions specified by C<with_meta> or C<as_is> take precedence over
723 functions exported by modules specified by C<also>, so that a module
724 can selectively override functions exported by another module.
726 C<Moose::Exporter> also makes sure all these functions get removed
727 when C<unimport> is called.
731 You can also provide parameters for C<Moose::Util::MetaRole::apply_metaroles>
732 and C<Moose::Util::MetaRole::base_class_roles>. Specifically, valid parameters
733 are "class_metaroles", "role_metaroles", and "base_class_roles".
735 =item B<< Moose::Exporter->build_import_methods(...) >>
737 Returns two or three code refs, one for C<import>, one for
738 C<unimport>, and optionally one for C<init_meta>, if the appropriate
739 options are passed in.
741 Accepts the additional C<install> option, which accepts an arrayref of method
742 names to install into your exporting package. The valid options are C<import>,
743 C<unimport>, and C<init_meta>. Calling C<setup_import_methods> is equivalent
744 to calling C<build_import_methods> with C<< install => [qw(import unimport
745 init_meta)] >> except that it doesn't also return the methods.
747 Used by C<setup_import_methods>.
751 =head1 IMPORTING AND init_meta
753 If you want to set an alternative base object class or metaclass class, see
754 above for details on how this module can call L<Moose::Util::MetaRole> for
757 If you want to do something that is not supported by this module, simply
758 define an C<init_meta> method in your class. The C<import> method that
759 C<Moose::Exporter> generates for you will call this method (if it exists). It
760 will always pass the caller to this method via the C<for_class> parameter.
762 Most of the time, your C<init_meta> method will probably just call C<<
763 Moose->init_meta >> to do the real work:
766 shift; # our class name
767 return Moose->init_meta( @_, metaclass => 'My::Metaclass' );
770 Keep in mind that C<build_import_methods> will return an C<init_meta>
771 method for you, which you can also call from within your custom
774 my ( $import, $unimport, $init_meta ) =
775 Moose::Exporter->build_import_methods( ... );
782 $class->$import(...);
787 sub unimport { goto &$unimport }
794 $class->$init_meta(...);
799 =head1 METACLASS TRAITS
801 The C<import> method generated by C<Moose::Exporter> will allow the
802 user of your module to specify metaclass traits in a C<-traits>
803 parameter passed as part of the import:
805 use Moose -traits => 'My::Meta::Trait';
807 use Moose -traits => [ 'My::Meta::Trait', 'My::Other::Trait' ];
809 These traits will be applied to the caller's metaclass
810 instance. Providing traits for an exporting class that does not create
811 a metaclass for the caller is an error.
815 See L<Moose/BUGS> for details on reporting bugs.
819 Dave Rolsky E<lt>autarch@urth.orgE<gt>
821 This is largely a reworking of code in Moose.pm originally written by
822 Stevan Little and others.
824 =head1 COPYRIGHT AND LICENSE
826 Copyright 2009 by Infinity Interactive, Inc.
828 L<http://www.iinteractive.com>
830 This library is free software; you can redistribute it and/or modify
831 it under the same terms as Perl itself.