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 = $class->_make_exporter($exports, $is_reexport);
57 $methods{import} = $class->_make_import_sub(
64 $methods{unimport} = $class->_make_unimport_sub(
71 $methods{init_meta} = $class->_make_init_meta(
76 my $package = Class::MOP::Package->initialize($exporting_package);
77 for my $to_install ( @{ $args{install} || [] } ) {
78 my $symbol = '&' . $to_install;
80 unless $methods{$to_install}
81 && !$package->has_package_symbol($symbol);
82 $package->add_package_symbol( $symbol, $methods{$to_install} );
85 return ( $methods{import}, $methods{unimport}, $methods{init_meta} );
89 my ($class, $exports, $is_reexport) = @_;
91 return Sub::Exporter::build_exporter(
94 groups => { default => [':all'] },
96 my ($arg, $to_export) = @_;
97 my $meta = Class::MOP::class_of($arg->{into});
99 goto &Sub::Exporter::default_installer unless $meta;
101 # don't overwrite existing symbols with our magically flagged
102 # version of it if we would install the same sub that's already
105 my @filtered_to_export;
107 for (my $i = 0; $i < @{ $to_export }; $i += 2) {
108 my ($as, $cv) = @{ $to_export }[$i, $i + 1];
111 && $meta->has_package_symbol('&' . $as)
112 && $meta->get_package_symbol('&' . $as) == $cv;
114 push @filtered_to_export, $as, $cv;
115 $installed{$as} = 1 unless ref $as;
118 Sub::Exporter::default_installer($arg, \@filtered_to_export);
120 for my $name ( keys %{$is_reexport} ) {
123 next unless exists $installed{$name};
124 _flag_as_reexport( \*{ join q{::}, $arg->{into}, $name } );
136 my $exporting_package = shift;
138 local %$seen = ( $exporting_package => 1 );
140 return uniq( _follow_also_real($exporting_package) );
143 sub _follow_also_real {
144 my $exporting_package = shift;
146 if ( !exists $EXPORT_SPEC{$exporting_package} ) {
147 my $loaded = Class::MOP::is_class_loaded($exporting_package);
149 die "Package in also ($exporting_package) does not seem to "
150 . "use Moose::Exporter"
151 . ( $loaded ? "" : " (is it loaded?)" );
154 my $also = $EXPORT_SPEC{$exporting_package}{also};
156 return unless defined $also;
158 my @also = ref $also ? @{$also} : $also;
160 for my $package (@also) {
162 "Circular reference in 'also' parameter to Moose::Exporter between $exporting_package and $package"
163 if $seen->{$package};
165 $seen->{$package} = 1;
168 return @also, map { _follow_also_real($_) } @also;
172 sub _parse_trait_aliases {
174 my ($package, $aliases) = @_;
177 for my $alias (@$aliases) {
180 reftype($alias) eq 'ARRAY'
181 or Moose->throw_error(reftype($alias) . " references are not "
182 . "valid arguments to the 'trait_aliases' "
185 ($alias, $name) = @$alias;
188 ($name = $alias) =~ s/.*:://;
190 push @ret, subname "${package}::${name}" => sub () { $alias };
196 sub _make_sub_exporter_params {
198 my $packages = shift;
199 my $export_recorder = shift;
200 my $is_reexport = shift;
204 for my $package ( @{$packages} ) {
205 my $args = $EXPORT_SPEC{$package}
206 or die "The $package package does not use Moose::Exporter\n";
208 for my $name ( @{ $args->{with_meta} } ) {
209 my $sub = $class->_sub_from_package( $package, $name )
212 my $fq_name = $package . '::' . $name;
214 $exports{$name} = $class->_make_wrapped_sub_with_meta(
221 for my $name ( @{ $args->{with_caller} } ) {
222 my $sub = $class->_sub_from_package( $package, $name )
225 my $fq_name = $package . '::' . $name;
227 $exports{$name} = $class->_make_wrapped_sub(
234 my @extra_exports = $class->_parse_trait_aliases(
235 $package, $args->{trait_aliases},
237 for my $name ( @{ $args->{as_is} }, @extra_exports ) {
238 my ( $sub, $coderef_name );
244 ( $coderef_pkg, $coderef_name )
245 = Class::MOP::get_code_info($name);
247 if ( $coderef_pkg ne $package ) {
248 $is_reexport->{$coderef_name} = 1;
252 $sub = $class->_sub_from_package( $package, $name )
255 $coderef_name = $name;
258 $export_recorder->{$sub} = 1;
260 $exports{$coderef_name} = sub {$sub};
267 sub _sub_from_package {
274 \&{ $package . '::' . $name };
277 return $sub if defined &$sub;
279 Carp::cluck "Trying to export undefined sub ${package}::${name}";
286 sub _make_wrapped_sub {
290 my $export_recorder = shift;
292 # We need to set the package at import time, so that when
293 # package Foo imports has(), we capture "Foo" as the
294 # package. This lets other packages call Foo::has() and get
295 # the right package. This is done for backwards compatibility
296 # with existing production code, not because this is a good
299 my $caller = $CALLER;
301 my $wrapper = $self->_curry_wrapper( $sub, $fq_name, $caller );
303 my $sub = subname( $fq_name => $wrapper );
305 $export_recorder->{$sub} = 1;
311 sub _make_wrapped_sub_with_meta {
315 my $export_recorder = shift;
318 my $caller = $CALLER;
320 my $wrapper = $self->_late_curry_wrapper(
322 sub { Class::MOP::class_of(shift) } => $caller
325 my $sub = subname( $fq_name => $wrapper );
327 $export_recorder->{$sub} = 1;
339 my $wrapper = sub { $sub->( @extra, @_ ) };
340 if ( my $proto = prototype $sub ) {
342 # XXX - Perl's prototype sucks. Use & to make set_prototype
343 # ignore the fact that we're passing "private variables"
344 &Scalar::Util::set_prototype( $wrapper, $proto );
349 sub _late_curry_wrapper {
358 # resolve curried arguments at runtime via this closure
359 my @curry = ( $extra->(@ex_args) );
360 return $sub->( @curry, @_ );
363 if ( my $proto = prototype $sub ) {
365 # XXX - Perl's prototype sucks. Use & to make set_prototype
366 # ignore the fact that we're passing "private variables"
367 &Scalar::Util::set_prototype( $wrapper, $proto );
372 sub _make_import_sub {
374 my $exporting_package = shift;
375 my $exporter = shift;
376 my $exports_from = shift;
377 my $is_reexport = shift;
381 # I think we could use Sub::Exporter's collector feature
382 # to do this, but that would be rather gross, since that
383 # feature isn't really designed to return a value to the
384 # caller of the exporter sub.
386 # Also, this makes sure we preserve backwards compat for
387 # _get_caller, so it always sees the arguments in the
390 ( $traits, @_ ) = _strip_traits(@_);
393 ( $metaclass, @_ ) = _strip_metaclass(@_);
395 = Moose::Util::resolve_metaclass_alias( 'Class' => $metaclass )
396 if defined $metaclass && length $metaclass;
399 ( $meta_name, @_ ) = _strip_meta_name(@_);
401 # Normally we could look at $_[0], but in some weird cases
402 # (involving goto &Moose::import), $_[0] ends as something
403 # else (like Squirrel).
404 my $class = $exporting_package;
406 $CALLER = _get_caller(@_);
408 # this works because both pragmas set $^H (see perldoc
409 # perlvar) which affects the current compilation -
410 # i.e. the file who use'd us - which is why we don't need
411 # to do anything special to make it affect that file
412 # rather than this one (which is already compiled)
418 for my $c ( grep { $_->can('init_meta') } $class, @{$exports_from} ) {
420 # init_meta can apply a role, which when loaded uses
421 # Moose::Exporter, which in turn sets $CALLER, so we need
422 # to protect against that.
423 local $CALLER = $CALLER;
425 for_class => $CALLER,
426 metaclass => $metaclass,
427 meta_name => $meta_name,
432 if ( $did_init_meta && @{$traits} ) {
434 # The traits will use Moose::Role, which in turn uses
435 # Moose::Exporter, which in turn sets $CALLER, so we need
436 # to protect against that.
437 local $CALLER = $CALLER;
438 _apply_meta_traits( $CALLER, $traits );
440 elsif ( @{$traits} ) {
443 "Cannot provide traits when $class does not have an init_meta() method"
447 my ( undef, @args ) = @_;
448 my $extra = shift @args if ref $args[0] eq 'HASH';
451 if ( !$extra->{into} ) {
452 $extra->{into_level} ||= 0;
453 $extra->{into_level}++;
456 $class->$exporter( $extra, @args );
461 my $idx = first_index { ( $_ || '' ) eq '-traits' } @_;
463 return ( [], @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
465 my $traits = $_[ $idx + 1 ];
469 $traits = [$traits] unless ref $traits;
471 return ( $traits, @_ );
474 sub _strip_metaclass {
475 my $idx = first_index { ( $_ || '' ) eq '-metaclass' } @_;
477 return ( undef, @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
479 my $metaclass = $_[ $idx + 1 ];
483 return ( $metaclass, @_ );
486 sub _strip_meta_name {
487 my $idx = first_index { ( $_ || '' ) eq '-meta_name' } @_;
489 return ( 'meta', @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
491 my $meta_name = $_[ $idx + 1 ];
495 return ( $meta_name, @_ );
498 sub _apply_meta_traits {
499 my ( $class, $traits ) = @_;
501 return unless @{$traits};
503 my $meta = Class::MOP::class_of($class);
505 my $type = ( split /::/, ref $meta )[-1]
506 or Moose->throw_error(
507 'Cannot determine metaclass type for trait application . Meta isa '
510 my @resolved_traits = map {
513 : Moose::Util::resolve_metatrait_alias( $type => $_ )
516 return unless @resolved_traits;
518 my %args = ( for => $class );
520 if ( $meta->isa('Moose::Meta::Role') ) {
521 $args{role_metaroles} = { role => \@resolved_traits };
524 $args{class_metaroles} = { class => \@resolved_traits };
527 Moose::Util::MetaRole::apply_metaroles(%args);
532 # 1 extra level because it's called by import so there's a layer
537 ( ref $_[1] && defined $_[1]->{into} ) ? $_[1]->{into}
538 : ( ref $_[1] && defined $_[1]->{into_level} )
539 ? caller( $offset + $_[1]->{into_level} )
543 sub _make_unimport_sub {
545 my $exporting_package = shift;
547 my $export_recorder = shift;
548 my $is_reexport = shift;
551 my $caller = scalar caller();
552 Moose::Exporter->_remove_keywords(
554 [ keys %{$exports} ],
561 sub _remove_keywords {
564 my $keywords = shift;
565 my $recorded_exports = shift;
566 my $is_reexport = shift;
570 foreach my $name ( @{$keywords} ) {
571 if ( defined &{ $package . '::' . $name } ) {
572 my $sub = \&{ $package . '::' . $name };
574 # make sure it is from us
575 next unless $recorded_exports->{$sub};
577 if ( $is_reexport->{$name} ) {
580 unless _export_is_flagged(
581 \*{ join q{::} => $package, $name } );
584 # and if it is from us, then undef the slot
585 delete ${ $package . '::' }{$name};
590 sub _make_init_meta {
602 wrapped_method_metaclass
609 $old_style_roles{$role} = $args->{$role}
610 if exists $args->{$role};
613 my %base_class_roles;
614 %base_class_roles = ( roles => $args->{base_class_roles} )
615 if exists $args->{base_class_roles};
617 my %new_style_roles = map { $_ => $args->{$_} }
618 grep { exists $args->{$_} } qw( class_metaroles role_metaroles );
620 return unless %new_style_roles || %old_style_roles || %base_class_roles;
626 return unless Class::MOP::class_of( $options{for_class} );
628 if ( %new_style_roles || %old_style_roles ) {
629 Moose::Util::MetaRole::apply_metaroles(
630 for => $options{for_class},
636 Moose::Util::MetaRole::apply_base_class_roles(
637 for_class => $options{for_class},
640 if Class::MOP::class_of( $options{for_class} )
641 ->isa('Moose::Meta::Class');
643 return Class::MOP::class_of( $options{for_class} );
658 Moose::Exporter - make an import() and unimport() just like Moose.pm
662 package MyApp::Moose;
667 Moose::Exporter->setup_import_methods(
668 with_meta => [ 'has_rw', 'sugar2' ],
669 as_is => [ 'sugar3', \&Some::Random::thing ],
674 my ( $meta, $name, %options ) = @_;
675 $meta->add_attribute(
695 This module encapsulates the exporting of sugar functions in a
696 C<Moose.pm>-like manner. It does this by building custom C<import>,
697 C<unimport>, and C<init_meta> methods for your module, based on a spec you
700 It also lets you "stack" Moose-alike modules so you can export Moose's sugar
701 as well as your own, along with sugar from any random C<MooseX> module, as
702 long as they all use C<Moose::Exporter>. This feature exists to let you bundle
703 a set of MooseX modules into a policy module that developers can use directly
704 instead of using Moose itself.
706 To simplify writing exporter modules, C<Moose::Exporter> also imports
707 C<strict> and C<warnings> into your exporter module, as well as into
712 This module provides two public methods:
716 =item B<< Moose::Exporter->setup_import_methods(...) >>
718 When you call this method, C<Moose::Exporter> builds custom C<import>,
719 C<unimport>, and C<init_meta> methods for your module. The C<import> method
720 will export the functions you specify, and can also re-export functions
721 exported by some other module (like C<Moose.pm>).
723 The C<unimport> method cleans the caller's namespace of all the exported
724 functions. This includes any functions you re-export from other
725 packages. However, if the consumer of your package also imports those
726 functions from the original package, they will I<not> be cleaned.
728 If you pass any parameters for L<Moose::Util::MetaRole>, this method will
729 generate an C<init_meta> for you as well (see below for details). This
730 C<init_meta> will call C<Moose::Util::MetaRole::apply_metaroles> and
731 C<Moose::Util::MetaRole::apply_base_class_roles> as needed.
733 Note that if any of these methods already exist, they will not be
734 overridden, you will have to use C<build_import_methods> to get the
735 coderef that would be installed.
737 This method accepts the following parameters:
741 =item * with_meta => [ ... ]
743 This list of function I<names only> will be wrapped and then exported. The
744 wrapper will pass the metaclass object for the caller as its first argument.
746 Many sugar functions will need to use this metaclass object to do something to
749 =item * as_is => [ ... ]
751 This list of function names or sub references will be exported as-is. You can
752 identify a subroutine by reference, which is handy to re-export some other
753 module's functions directly by reference (C<\&Some::Package::function>).
755 If you do export some other package's function, this function will never be
756 removed by the C<unimport> method. The reason for this is we cannot know if
757 the caller I<also> explicitly imported the sub themselves, and therefore wants
760 =item * trait_aliases => [ ... ]
762 This is a list of package names which should have shortened alias exported,
763 similar to the functionality of L<aliased>. Each element in the list can be
764 either a package name, in which case the export will be named as the last
765 namespace component of the package, or an arrayref, whose first element is the
766 package to alias to, and second element is the alias to export.
768 =item * also => $name or \@names
770 This is a list of modules which contain functions that the caller
771 wants to export. These modules must also use C<Moose::Exporter>. The
772 most common use case will be to export the functions from C<Moose.pm>.
773 Functions specified by C<with_meta> or C<as_is> take precedence over
774 functions exported by modules specified by C<also>, so that a module
775 can selectively override functions exported by another module.
777 C<Moose::Exporter> also makes sure all these functions get removed
778 when C<unimport> is called.
782 You can also provide parameters for C<Moose::Util::MetaRole::apply_metaroles>
783 and C<Moose::Util::MetaRole::base_class_roles>. Specifically, valid parameters
784 are "class_metaroles", "role_metaroles", and "base_class_roles".
786 =item B<< Moose::Exporter->build_import_methods(...) >>
788 Returns two or three code refs, one for C<import>, one for
789 C<unimport>, and optionally one for C<init_meta>, if the appropriate
790 options are passed in.
792 Accepts the additional C<install> option, which accepts an arrayref of method
793 names to install into your exporting package. The valid options are C<import>,
794 C<unimport>, and C<init_meta>. Calling C<setup_import_methods> is equivalent
795 to calling C<build_import_methods> with C<< install => [qw(import unimport
796 init_meta)] >> except that it doesn't also return the methods.
798 Used by C<setup_import_methods>.
802 =head1 IMPORTING AND init_meta
804 If you want to set an alternative base object class or metaclass class, see
805 above for details on how this module can call L<Moose::Util::MetaRole> for
808 If you want to do something that is not supported by this module, simply
809 define an C<init_meta> method in your class. The C<import> method that
810 C<Moose::Exporter> generates for you will call this method (if it exists). It
811 will always pass the caller to this method via the C<for_class> parameter.
813 Most of the time, your C<init_meta> method will probably just call C<<
814 Moose->init_meta >> to do the real work:
817 shift; # our class name
818 return Moose->init_meta( @_, metaclass => 'My::Metaclass' );
821 Keep in mind that C<build_import_methods> will return an C<init_meta>
822 method for you, which you can also call from within your custom
825 my ( $import, $unimport, $init_meta ) =
826 Moose::Exporter->build_import_methods( ... );
833 $class->$import(...);
838 sub unimport { goto &$unimport }
845 $class->$init_meta(...);
850 =head1 METACLASS TRAITS
852 The C<import> method generated by C<Moose::Exporter> will allow the
853 user of your module to specify metaclass traits in a C<-traits>
854 parameter passed as part of the import:
856 use Moose -traits => 'My::Meta::Trait';
858 use Moose -traits => [ 'My::Meta::Trait', 'My::Other::Trait' ];
860 These traits will be applied to the caller's metaclass
861 instance. Providing traits for an exporting class that does not create
862 a metaclass for the caller is an error.
866 See L<Moose/BUGS> for details on reporting bugs.
870 Dave Rolsky E<lt>autarch@urth.orgE<gt>
872 This is largely a reworking of code in Moose.pm originally written by
873 Stevan Little and others.
875 =head1 COPYRIGHT AND LICENSE
877 Copyright 2009 by Infinity Interactive, Inc.
879 L<http://www.iinteractive.com>
881 This library is free software; you can redistribute it and/or modify
882 it under the same terms as Perl itself.