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::Util::MetaRole;
14 use Sub::Exporter 0.980;
15 use Sub::Name qw(subname);
19 XSLoader::load( 'Moose', $XS_VERSION );
23 sub setup_import_methods {
24 my ( $class, %args ) = @_;
26 my $exporting_package = $args{exporting_package} ||= caller();
28 $class->build_import_methods(
30 install => [qw(import unimport init_meta)]
34 sub build_import_methods {
35 my ( $class, %args ) = @_;
37 my $exporting_package = $args{exporting_package} ||= caller();
39 $EXPORT_SPEC{$exporting_package} = \%args;
41 my @exports_from = $class->_follow_also($exporting_package);
43 my $export_recorder = {};
46 my $exports = $class->_make_sub_exporter_params(
47 [ @exports_from, $exporting_package ],
52 my $exporter = Sub::Exporter::build_exporter(
55 groups => { default => [':all'] }
60 $methods{import} = $class->_make_import_sub(
65 ($args{init_meta_params} || []),
68 $methods{unimport} = $class->_make_unimport_sub(
75 $methods{init_meta} = $class->_make_init_meta(
80 my $package = Class::MOP::Package->initialize($exporting_package);
81 for my $to_install ( @{ $args{install} || [] } ) {
82 my $symbol = '&' . $to_install;
84 unless $methods{$to_install}
85 && !$package->has_package_symbol($symbol);
86 $package->add_package_symbol( $symbol, $methods{$to_install} );
89 return ( $methods{import}, $methods{unimport}, $methods{init_meta} );
97 my $exporting_package = shift;
99 local %$seen = ( $exporting_package => 1 );
101 return uniq( _follow_also_real($exporting_package) );
104 sub _follow_also_real {
105 my $exporting_package = shift;
107 if ( !exists $EXPORT_SPEC{$exporting_package} ) {
108 my $loaded = Class::MOP::is_class_loaded($exporting_package);
110 die "Package in also ($exporting_package) does not seem to "
111 . "use Moose::Exporter"
112 . ( $loaded ? "" : " (is it loaded?)" );
115 my $also = $EXPORT_SPEC{$exporting_package}{also};
117 return unless defined $also;
119 my @also = ref $also ? @{$also} : $also;
121 for my $package (@also) {
123 "Circular reference in 'also' parameter to Moose::Exporter between $exporting_package and $package"
124 if $seen->{$package};
126 $seen->{$package} = 1;
129 return @also, map { _follow_also_real($_) } @also;
133 sub _make_sub_exporter_params {
135 my $packages = shift;
136 my $export_recorder = shift;
137 my $is_reexport = shift;
141 for my $package ( @{$packages} ) {
142 my $args = $EXPORT_SPEC{$package}
143 or die "The $package package does not use Moose::Exporter\n";
145 for my $name ( @{ $args->{with_meta} } ) {
146 my $sub = $class->_sub_from_package( $package, $name )
149 my $fq_name = $package . '::' . $name;
151 $exports{$name} = $class->_make_wrapped_sub_with_meta(
158 for my $name ( @{ $args->{with_caller} } ) {
159 my $sub = $class->_sub_from_package( $package, $name )
162 my $fq_name = $package . '::' . $name;
164 $exports{$name} = $class->_make_wrapped_sub(
171 for my $name ( @{ $args->{as_is} } ) {
172 my ( $sub, $coderef_name );
178 ( $coderef_pkg, $coderef_name )
179 = Class::MOP::get_code_info($name);
181 if ( $coderef_pkg ne $package ) {
182 $is_reexport->{$coderef_name} = 1;
186 $sub = $class->_sub_from_package( $package, $name )
189 $coderef_name = $name;
192 $export_recorder->{$sub} = 1;
194 $exports{$coderef_name} = sub {$sub};
201 sub _sub_from_package {
208 \&{ $package . '::' . $name };
211 return $sub if defined &$sub;
213 Carp::cluck "Trying to export undefined sub ${package}::${name}";
220 sub _make_wrapped_sub {
224 my $export_recorder = shift;
226 # We need to set the package at import time, so that when
227 # package Foo imports has(), we capture "Foo" as the
228 # package. This lets other packages call Foo::has() and get
229 # the right package. This is done for backwards compatibility
230 # with existing production code, not because this is a good
233 my $caller = $CALLER;
235 my $wrapper = $self->_curry_wrapper( $sub, $fq_name, $caller );
237 my $sub = subname( $fq_name => $wrapper );
239 $export_recorder->{$sub} = 1;
245 sub _make_wrapped_sub_with_meta {
249 my $export_recorder = shift;
252 my $caller = $CALLER;
254 my $wrapper = $self->_late_curry_wrapper(
256 sub { Class::MOP::class_of(shift) } => $caller
259 my $sub = subname( $fq_name => $wrapper );
261 $export_recorder->{$sub} = 1;
273 my $wrapper = sub { $sub->( @extra, @_ ) };
274 if ( my $proto = prototype $sub ) {
276 # XXX - Perl's prototype sucks. Use & to make set_prototype
277 # ignore the fact that we're passing "private variables"
278 &Scalar::Util::set_prototype( $wrapper, $proto );
283 sub _late_curry_wrapper {
292 # resolve curried arguments at runtime via this closure
293 my @curry = ( $extra->(@ex_args) );
294 return $sub->( @curry, @_ );
297 if ( my $proto = prototype $sub ) {
299 # XXX - Perl's prototype sucks. Use & to make set_prototype
300 # ignore the fact that we're passing "private variables"
301 &Scalar::Util::set_prototype( $wrapper, $proto );
306 sub _make_import_sub {
308 my $exporting_package = shift;
309 my $exporter = shift;
310 my $exports_from = shift;
311 my $is_reexport = shift;
312 my $init_meta_params = shift;
316 # I think we could use Sub::Exporter's collector feature
317 # to do this, but that would be rather gross, since that
318 # feature isn't really designed to return a value to the
319 # caller of the exporter sub.
321 # Also, this makes sure we preserve backwards compat for
322 # _get_caller, so it always sees the arguments in the
325 ( $traits, @_ ) = _strip_traits(@_);
328 ( $metaclass, @_ ) = _strip_metaclass(@_);
330 = Moose::Util::resolve_metaclass_alias( 'Class' => $metaclass )
331 if defined $metaclass && length $metaclass;
333 # Normally we could look at $_[0], but in some weird cases
334 # (involving goto &Moose::import), $_[0] ends as something
335 # else (like Squirrel).
336 my $class = $exporting_package;
338 $CALLER = _get_caller(@_);
340 # this works because both pragmas set $^H (see perldoc
341 # perlvar) which affects the current compilation -
342 # i.e. the file who use'd us - which is why we don't need
343 # to do anything special to make it affect that file
344 # rather than this one (which is already compiled)
350 # don't want to just force @_ into a hash, since it really actually is
354 if (grep { $_ eq $_[$i] } @$init_meta_params) {
355 $extra_args{$_[$i]} = $_[$i + 1];
364 for my $c ( grep { $_->can('init_meta') } $class, @{$exports_from} ) {
366 # init_meta can apply a role, which when loaded uses
367 # Moose::Exporter, which in turn sets $CALLER, so we need
368 # to protect against that.
369 local $CALLER = $CALLER;
372 for_class => $CALLER,
373 metaclass => $metaclass,
378 if ( $did_init_meta && @{$traits} ) {
380 # The traits will use Moose::Role, which in turn uses
381 # Moose::Exporter, which in turn sets $CALLER, so we need
382 # to protect against that.
383 local $CALLER = $CALLER;
384 _apply_meta_traits( $CALLER, $traits );
386 elsif ( @{$traits} ) {
389 "Cannot provide traits when $class does not have an init_meta() method"
393 my ( undef, @args ) = @_;
394 my $extra = shift @args if ref $args[0] eq 'HASH';
397 if ( !$extra->{into} ) {
398 $extra->{into_level} ||= 0;
399 $extra->{into_level}++;
402 $class->$exporter( $extra, @args );
404 for my $name ( keys %{$is_reexport} ) {
407 _flag_as_reexport( \*{ join q{::}, $CALLER, $name } );
413 my $idx = first_index { $_ eq '-traits' } @_;
415 return ( [], @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
417 my $traits = $_[ $idx + 1 ];
421 $traits = [$traits] unless ref $traits;
423 return ( $traits, @_ );
426 sub _strip_metaclass {
427 my $idx = first_index { $_ eq '-metaclass' } @_;
429 return ( undef, @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
431 my $metaclass = $_[ $idx + 1 ];
435 return ( $metaclass, @_ );
438 sub _apply_meta_traits {
439 my ( $class, $traits ) = @_;
441 return unless @{$traits};
443 my $meta = Class::MOP::class_of($class);
445 my $type = ( split /::/, ref $meta )[-1]
446 or Moose->throw_error(
447 'Cannot determine metaclass type for trait application . Meta isa '
450 my @resolved_traits = map {
453 : Moose::Util::resolve_metatrait_alias( $type => $_ )
456 return unless @resolved_traits;
458 my %args = ( for => $class );
460 if ( $meta->isa('Moose::Meta::Role') ) {
461 $args{role_metaroles} = { role => \@resolved_traits };
464 $args{class_metaroles} = { class => \@resolved_traits };
467 Moose::Util::MetaRole::apply_metaroles(%args);
472 # 1 extra level because it's called by import so there's a layer
477 ( ref $_[1] && defined $_[1]->{into} ) ? $_[1]->{into}
478 : ( ref $_[1] && defined $_[1]->{into_level} )
479 ? caller( $offset + $_[1]->{into_level} )
483 sub _make_unimport_sub {
485 my $exporting_package = shift;
487 my $export_recorder = shift;
488 my $is_reexport = shift;
491 my $caller = scalar caller();
492 Moose::Exporter->_remove_keywords(
494 [ keys %{$exports} ],
501 sub _remove_keywords {
504 my $keywords = shift;
505 my $recorded_exports = shift;
506 my $is_reexport = shift;
510 foreach my $name ( @{$keywords} ) {
511 if ( defined &{ $package . '::' . $name } ) {
512 my $sub = \&{ $package . '::' . $name };
514 # make sure it is from us
515 next unless $recorded_exports->{$sub};
517 if ( $is_reexport->{$name} ) {
520 unless _export_is_flagged(
521 \*{ join q{::} => $package, $name } );
524 # and if it is from us, then undef the slot
525 delete ${ $package . '::' }{$name};
530 sub _make_init_meta {
542 wrapped_method_metaclass
549 $old_style_roles{$role} = $args->{$role}
550 if exists $args->{$role};
553 my %base_class_roles;
554 %base_class_roles = ( roles => $args->{base_class_roles} )
555 if exists $args->{base_class_roles};
557 my %new_style_roles = map { $_ => $args->{$_} }
558 grep { exists $args->{$_} } qw( class_metaroles role_metaroles );
560 return unless %new_style_roles || %old_style_roles || %base_class_roles;
566 return unless Class::MOP::class_of( $options{for_class} );
568 Moose::Util::MetaRole::apply_metaroles(
569 for => $options{for_class},
574 Moose::Util::MetaRole::apply_base_class_roles(
575 for_class => $options{for_class},
578 if Class::MOP::class_of( $options{for_class} )
579 ->isa('Moose::Meta::Class');
581 return Class::MOP::class_of( $options{for_class} );
596 Moose::Exporter - make an import() and unimport() just like Moose.pm
600 package MyApp::Moose;
605 Moose::Exporter->setup_import_methods(
606 with_meta => [ 'has_rw', 'sugar2' ],
607 as_is => [ 'sugar3', \&Some::Random::thing ],
612 my ( $meta, $name, %options ) = @_;
613 $meta->add_attribute(
633 This module encapsulates the exporting of sugar functions in a
634 C<Moose.pm>-like manner. It does this by building custom C<import>,
635 C<unimport>, and C<init_meta> methods for your module, based on a spec you
638 It also lets you "stack" Moose-alike modules so you can export Moose's sugar
639 as well as your own, along with sugar from any random C<MooseX> module, as
640 long as they all use C<Moose::Exporter>. This feature exists to let you bundle
641 a set of MooseX modules into a policy module that developers can use directly
642 instead of using Moose itself.
644 To simplify writing exporter modules, C<Moose::Exporter> also imports
645 C<strict> and C<warnings> into your exporter module, as well as into
650 This module provides two public methods:
654 =item B<< Moose::Exporter->setup_import_methods(...) >>
656 When you call this method, C<Moose::Exporter> builds custom C<import>,
657 C<unimport>, and C<init_meta> methods for your module. The C<import> method
658 will export the functions you specify, and can also re-export functions
659 exported by some other module (like C<Moose.pm>).
661 The C<unimport> method cleans the caller's namespace of all the exported
662 functions. This includes any functions you re-export from other
663 packages. However, if the consumer of your package also imports those
664 functions from the original package, they will I<not> be cleaned.
666 If you pass any parameters for L<Moose::Util::MetaRole>, this method will
667 generate an C<init_meta> for you as well (see below for details). This
668 C<init_meta> will call C<Moose::Util::MetaRole::apply_metaclass_roles> and
669 C<Moose::Util::MetaRole::apply_base_class_roles> as needed.
671 Note that if any of these methods already exist, they will not be
672 overridden, you will have to use C<build_import_methods> to get the
673 coderef that would be installed.
675 This method accepts the following parameters:
679 =item * with_meta => [ ... ]
681 This list of function I<names only> will be wrapped and then exported. The
682 wrapper will pass the metaclass object for the caller as its first argument.
684 Many sugar functions will need to use this metaclass object to do something to
687 =item * as_is => [ ... ]
689 This list of function names or sub references will be exported as-is. You can
690 identify a subroutine by reference, which is handy to re-export some other
691 module's functions directly by reference (C<\&Some::Package::function>).
693 If you do export some other package's function, this function will never be
694 removed by the C<unimport> method. The reason for this is we cannot know if
695 the caller I<also> explicitly imported the sub themselves, and therefore wants
698 =item * also => $name or \@names
700 This is a list of modules which contain functions that the caller
701 wants to export. These modules must also use C<Moose::Exporter>. The
702 most common use case will be to export the functions from C<Moose.pm>.
703 Functions specified by C<with_meta> or C<as_is> take precedence over
704 functions exported by modules specified by C<also>, so that a module
705 can selectively override functions exported by another module.
707 C<Moose::Exporter> also makes sure all these functions get removed
708 when C<unimport> is called.
710 =item * init_meta_params => [ ... ]
712 This is a list of keys to search for in the import argument list. Any
713 keys which are found will be passed with their corresponding values
714 into C<init_meta> when it is called.
718 You can also provide parameters for C<Moose::Util::MetaRole::apply_metaroles>
719 and C<Moose::Util::MetaRole::base_class_roles>. Specifically, valid parameters
720 are "class_metaroles", "role_metaroles", and "base_object_roles".
722 =item B<< Moose::Exporter->build_import_methods(...) >>
724 Returns two or three code refs, one for C<import>, one for
725 C<unimport>, and optionally one for C<init_meta>, if the appropriate
726 options are passed in.
728 Accepts the additional C<install> option, which accepts an arrayref of method
729 names to install into your exporting package. The valid options are C<import>,
730 C<unimport>, and C<init_meta>. Calling C<setup_import_methods> is equivalent
731 to calling C<build_import_methods> with C<< install => [qw(import unimport
732 init_meta)] >> except that it doesn't also return the methods.
734 Used by C<setup_import_methods>.
738 =head1 IMPORTING AND init_meta
740 If you want to set an alternative base object class or metaclass class, see
741 above for details on how this module can call L<Moose::Util::MetaRole> for
744 If you want to do something that is not supported by this module, simply
745 define an C<init_meta> method in your class. The C<import> method that
746 C<Moose::Exporter> generates for you will call this method (if it exists). It
747 will always pass the caller to this method via the C<for_class> parameter.
749 Most of the time, your C<init_meta> method will probably just call C<<
750 Moose->init_meta >> to do the real work:
753 shift; # our class name
754 return Moose->init_meta( @_, metaclass => 'My::Metaclass' );
757 Keep in mind that C<build_import_methods> will return an C<init_meta>
758 method for you, which you can also call from within your custom
761 my ( $import, $unimport, $init_meta ) =
762 Moose::Exporter->build_import_methods( ... );
769 $class->$import(...);
774 sub unimport { goto &$unimport }
781 $class->$init_meta(...);
786 =head1 METACLASS TRAITS
788 The C<import> method generated by C<Moose::Exporter> will allow the
789 user of your module to specify metaclass traits in a C<-traits>
790 parameter passed as part of the import:
792 use Moose -traits => 'My::Meta::Trait';
794 use Moose -traits => [ 'My::Meta::Trait', 'My::Other::Trait' ];
796 These traits will be applied to the caller's metaclass
797 instance. Providing traits for an exporting class that does not create
798 a metaclass for the caller is an error.
802 See L<Moose/BUGS> for details on reporting bugs.
806 Dave Rolsky E<lt>autarch@urth.orgE<gt>
808 This is largely a reworking of code in Moose.pm originally written by
809 Stevan Little and others.
811 =head1 COPYRIGHT AND LICENSE
813 Copyright 2009 by Infinity Interactive, Inc.
815 L<http://www.iinteractive.com>
817 This library is free software; you can redistribute it and/or modify
818 it under the same terms as Perl itself.