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(
67 $methods{unimport} = $class->_make_unimport_sub(
74 $methods{init_meta} = $class->_make_init_meta(
79 my $package = Class::MOP::Package->initialize($exporting_package);
80 for my $to_install ( @{ $args{install} || [] } ) {
81 my $symbol = '&' . $to_install;
83 unless $methods{$to_install}
84 && !$package->has_package_symbol($symbol);
85 $package->add_package_symbol( $symbol, $methods{$to_install} );
88 return ( $methods{import}, $methods{unimport}, $methods{init_meta} );
96 my $exporting_package = shift;
98 local %$seen = ( $exporting_package => 1 );
100 return uniq( _follow_also_real($exporting_package) );
103 sub _follow_also_real {
104 my $exporting_package = shift;
106 if ( !exists $EXPORT_SPEC{$exporting_package} ) {
107 my $loaded = Class::MOP::is_class_loaded($exporting_package);
109 die "Package in also ($exporting_package) does not seem to "
110 . "use Moose::Exporter"
111 . ( $loaded ? "" : " (is it loaded?)" );
114 my $also = $EXPORT_SPEC{$exporting_package}{also};
116 return unless defined $also;
118 my @also = ref $also ? @{$also} : $also;
120 for my $package (@also) {
122 "Circular reference in 'also' parameter to Moose::Exporter between $exporting_package and $package"
123 if $seen->{$package};
125 $seen->{$package} = 1;
128 return @also, map { _follow_also_real($_) } @also;
132 sub _make_sub_exporter_params {
134 my $packages = shift;
135 my $export_recorder = shift;
136 my $is_reexport = shift;
140 for my $package ( @{$packages} ) {
141 my $args = $EXPORT_SPEC{$package}
142 or die "The $package package does not use Moose::Exporter\n";
144 for my $name ( @{ $args->{with_meta} } ) {
145 my $sub = $class->_sub_from_package( $package, $name )
148 my $fq_name = $package . '::' . $name;
150 $exports{$name} = $class->_make_wrapped_sub_with_meta(
157 for my $name ( @{ $args->{with_caller} } ) {
158 my $sub = $class->_sub_from_package( $package, $name )
161 my $fq_name = $package . '::' . $name;
163 $exports{$name} = $class->_make_wrapped_sub(
170 for my $name ( @{ $args->{as_is} } ) {
171 my ( $sub, $coderef_name );
177 ( $coderef_pkg, $coderef_name )
178 = Class::MOP::get_code_info($name);
180 if ( $coderef_pkg ne $package ) {
181 $is_reexport->{$coderef_name} = 1;
185 $sub = $class->_sub_from_package( $package, $name )
188 $coderef_name = $name;
191 $export_recorder->{$sub} = 1;
193 $exports{$coderef_name} = sub {$sub};
200 sub _sub_from_package {
207 \&{ $package . '::' . $name };
210 return $sub if defined &$sub;
212 Carp::cluck "Trying to export undefined sub ${package}::${name}";
219 sub _make_wrapped_sub {
223 my $export_recorder = shift;
225 # We need to set the package at import time, so that when
226 # package Foo imports has(), we capture "Foo" as the
227 # package. This lets other packages call Foo::has() and get
228 # the right package. This is done for backwards compatibility
229 # with existing production code, not because this is a good
232 my $caller = $CALLER;
234 my $wrapper = $self->_curry_wrapper( $sub, $fq_name, $caller );
236 my $sub = subname( $fq_name => $wrapper );
238 $export_recorder->{$sub} = 1;
244 sub _make_wrapped_sub_with_meta {
248 my $export_recorder = shift;
251 my $caller = $CALLER;
253 my $wrapper = $self->_late_curry_wrapper(
255 sub { Class::MOP::class_of(shift) } => $caller
258 my $sub = subname( $fq_name => $wrapper );
260 $export_recorder->{$sub} = 1;
272 my $wrapper = sub { $sub->( @extra, @_ ) };
273 if ( my $proto = prototype $sub ) {
275 # XXX - Perl's prototype sucks. Use & to make set_prototype
276 # ignore the fact that we're passing "private variables"
277 &Scalar::Util::set_prototype( $wrapper, $proto );
282 sub _late_curry_wrapper {
291 # resolve curried arguments at runtime via this closure
292 my @curry = ( $extra->(@ex_args) );
293 return $sub->( @curry, @_ );
296 if ( my $proto = prototype $sub ) {
298 # XXX - Perl's prototype sucks. Use & to make set_prototype
299 # ignore the fact that we're passing "private variables"
300 &Scalar::Util::set_prototype( $wrapper, $proto );
305 sub _make_import_sub {
307 my $exporting_package = shift;
308 my $exporter = shift;
309 my $exports_from = shift;
310 my $is_reexport = shift;
314 # I think we could use Sub::Exporter's collector feature
315 # to do this, but that would be rather gross, since that
316 # feature isn't really designed to return a value to the
317 # caller of the exporter sub.
319 # Also, this makes sure we preserve backwards compat for
320 # _get_caller, so it always sees the arguments in the
323 ( $traits, @_ ) = _strip_traits(@_);
326 ( $metaclass, @_ ) = _strip_metaclass(@_);
328 = Moose::Util::resolve_metaclass_alias( 'Class' => $metaclass )
329 if defined $metaclass && length $metaclass;
331 # Normally we could look at $_[0], but in some weird cases
332 # (involving goto &Moose::import), $_[0] ends as something
333 # else (like Squirrel).
334 my $class = $exporting_package;
336 $CALLER = _get_caller(@_);
338 # this works because both pragmas set $^H (see perldoc
339 # perlvar) which affects the current compilation -
340 # i.e. the file who use'd us - which is why we don't need
341 # to do anything special to make it affect that file
342 # rather than this one (which is already compiled)
348 for my $c ( grep { $_->can('init_meta') } $class, @{$exports_from} ) {
350 # init_meta can apply a role, which when loaded uses
351 # Moose::Exporter, which in turn sets $CALLER, so we need
352 # to protect against that.
353 local $CALLER = $CALLER;
354 $c->init_meta( for_class => $CALLER, metaclass => $metaclass );
358 if ( $did_init_meta && @{$traits} ) {
360 # The traits will use Moose::Role, which in turn uses
361 # Moose::Exporter, which in turn sets $CALLER, so we need
362 # to protect against that.
363 local $CALLER = $CALLER;
364 _apply_meta_traits( $CALLER, $traits );
366 elsif ( @{$traits} ) {
369 "Cannot provide traits when $class does not have an init_meta() method"
373 my ( undef, @args ) = @_;
374 my $extra = shift @args if ref $args[0] eq 'HASH';
377 if ( !$extra->{into} ) {
378 $extra->{into_level} ||= 0;
379 $extra->{into_level}++;
382 $class->$exporter( $extra, @args );
384 for my $name ( keys %{$is_reexport} ) {
387 _flag_as_reexport( \*{ join q{::}, $CALLER, $name } );
393 my $idx = first_index { $_ eq '-traits' } @_;
395 return ( [], @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
397 my $traits = $_[ $idx + 1 ];
401 $traits = [$traits] unless ref $traits;
403 return ( $traits, @_ );
406 sub _strip_metaclass {
407 my $idx = first_index { $_ eq '-metaclass' } @_;
409 return ( undef, @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
411 my $metaclass = $_[ $idx + 1 ];
415 return ( $metaclass, @_ );
418 sub _apply_meta_traits {
419 my ( $class, $traits ) = @_;
421 return unless @{$traits};
423 my $meta = Class::MOP::class_of($class);
425 my $type = ( split /::/, ref $meta )[-1]
426 or Moose->throw_error(
427 'Cannot determine metaclass type for trait application . Meta isa '
430 my @resolved_traits = map {
433 : Moose::Util::resolve_metatrait_alias( $type => $_ )
436 return unless @resolved_traits;
438 my %args = ( for => $class );
440 if ( $meta->isa('Moose::Meta::Role') ) {
441 $args{role_metaroles} = { role => \@resolved_traits };
444 $args{class_metaroles} = { class => \@resolved_traits };
447 Moose::Util::MetaRole::apply_metaroles(%args);
452 # 1 extra level because it's called by import so there's a layer
457 ( ref $_[1] && defined $_[1]->{into} ) ? $_[1]->{into}
458 : ( ref $_[1] && defined $_[1]->{into_level} )
459 ? caller( $offset + $_[1]->{into_level} )
463 sub _make_unimport_sub {
465 my $exporting_package = shift;
467 my $export_recorder = shift;
468 my $is_reexport = shift;
471 my $caller = scalar caller();
472 Moose::Exporter->_remove_keywords(
474 [ keys %{$exports} ],
481 sub _remove_keywords {
484 my $keywords = shift;
485 my $recorded_exports = shift;
486 my $is_reexport = shift;
490 foreach my $name ( @{$keywords} ) {
491 if ( defined &{ $package . '::' . $name } ) {
492 my $sub = \&{ $package . '::' . $name };
494 # make sure it is from us
495 next unless $recorded_exports->{$sub};
497 if ( $is_reexport->{$name} ) {
500 unless _export_is_flagged(
501 \*{ join q{::} => $package, $name } );
504 # and if it is from us, then undef the slot
505 delete ${ $package . '::' }{$name};
510 sub _make_init_meta {
522 wrapped_method_metaclass
529 $old_style_roles{$role} = $args->{$role}
530 if exists $args->{$role};
533 my %base_class_roles;
534 %base_class_roles = ( roles => $args->{base_class_roles} )
535 if exists $args->{base_class_roles};
537 my %new_style_roles = map { $_ => $args->{$_} }
538 grep { exists $args->{$_} } qw( class_metaroles role_metaroles );
540 return unless %new_style_roles || %old_style_roles || %base_class_roles;
546 return unless Class::MOP::class_of( $options{for_class} );
548 Moose::Util::MetaRole::apply_metaroles(
549 for => $options{for_class},
554 Moose::Util::MetaRole::apply_base_class_roles(
555 for_class => $options{for_class},
558 if Class::MOP::class_of( $options{for_class} )
559 ->isa('Moose::Meta::Class');
561 return Class::MOP::class_of( $options{for_class} );
576 Moose::Exporter - make an import() and unimport() just like Moose.pm
580 package MyApp::Moose;
585 Moose::Exporter->setup_import_methods(
586 with_meta => [ 'has_rw', 'sugar2' ],
587 as_is => [ 'sugar3', \&Some::Random::thing ],
592 my ( $meta, $name, %options ) = @_;
593 $meta->add_attribute(
613 This module encapsulates the exporting of sugar functions in a
614 C<Moose.pm>-like manner. It does this by building custom C<import>,
615 C<unimport>, and C<init_meta> methods for your module, based on a spec you
618 It also lets you "stack" Moose-alike modules so you can export Moose's sugar
619 as well as your own, along with sugar from any random C<MooseX> module, as
620 long as they all use C<Moose::Exporter>. This feature exists to let you bundle
621 a set of MooseX modules into a policy module that developers can use directly
622 instead of using Moose itself.
624 To simplify writing exporter modules, C<Moose::Exporter> also imports
625 C<strict> and C<warnings> into your exporter module, as well as into
630 This module provides two public methods:
634 =item B<< Moose::Exporter->setup_import_methods(...) >>
636 When you call this method, C<Moose::Exporter> builds custom C<import>,
637 C<unimport>, and C<init_meta> methods for your module. The C<import> method
638 will export the functions you specify, and can also re-export functions
639 exported by some other module (like C<Moose.pm>).
641 The C<unimport> method cleans the caller's namespace of all the exported
642 functions. This includes any functions you re-export from other
643 packages. However, if the consumer of your package also imports those
644 functions from the original package, they will I<not> be cleaned.
646 If you pass any parameters for L<Moose::Util::MetaRole>, this method will
647 generate an C<init_meta> for you as well (see below for details). This
648 C<init_meta> will call C<Moose::Util::MetaRole::apply_metaclass_roles> and
649 C<Moose::Util::MetaRole::apply_base_class_roles> as needed.
651 Note that if any of these methods already exist, they will not be
652 overridden, you will have to use C<build_import_methods> to get the
653 coderef that would be installed.
655 This method accepts the following parameters:
659 =item * with_meta => [ ... ]
661 This list of function I<names only> will be wrapped and then exported. The
662 wrapper will pass the metaclass object for the caller as its first argument.
664 Many sugar functions will need to use this metaclass object to do something to
667 =item * as_is => [ ... ]
669 This list of function names or sub references will be exported as-is. You can
670 identify a subroutine by reference, which is handy to re-export some other
671 module's functions directly by reference (C<\&Some::Package::function>).
673 If you do export some other package's function, this function will never be
674 removed by the C<unimport> method. The reason for this is we cannot know if
675 the caller I<also> explicitly imported the sub themselves, and therefore wants
678 =item * also => $name or \@names
680 This is a list of modules which contain functions that the caller
681 wants to export. These modules must also use C<Moose::Exporter>. The
682 most common use case will be to export the functions from C<Moose.pm>.
683 Functions specified by C<with_meta> or C<as_is> take precedence over
684 functions exported by modules specified by C<also>, so that a module
685 can selectively override functions exported by another module.
687 C<Moose::Exporter> also makes sure all these functions get removed
688 when C<unimport> is called.
692 You can also provide parameters for C<Moose::Util::MetaRole::apply_metaroles>
693 and C<Moose::Util::MetaRole::base_class_roles>. Specifically, valid parameters
694 are "class_metaroles", "role_metaroles", and "base_object_roles".
696 =item B<< Moose::Exporter->build_import_methods(...) >>
698 Returns two or three code refs, one for C<import>, one for
699 C<unimport>, and optionally one for C<init_meta>, if the appropriate
700 options are passed in.
702 Accepts the additional C<install> option, which accepts an arrayref of method
703 names to install into your exporting package. The valid options are C<import>,
704 C<unimport>, and C<init_meta>. Calling C<setup_import_methods> is equivalent
705 to calling C<build_import_methods> with C<< install => [qw(import unimport
706 init_meta)] >> except that it doesn't also return the methods.
708 Used by C<setup_import_methods>.
712 =head1 IMPORTING AND init_meta
714 If you want to set an alternative base object class or metaclass class, see
715 above for details on how this module can call L<Moose::Util::MetaRole> for
718 If you want to do something that is not supported by this module, simply
719 define an C<init_meta> method in your class. The C<import> method that
720 C<Moose::Exporter> generates for you will call this method (if it exists). It
721 will always pass the caller to this method via the C<for_class> parameter.
723 Most of the time, your C<init_meta> method will probably just call C<<
724 Moose->init_meta >> to do the real work:
727 shift; # our class name
728 return Moose->init_meta( @_, metaclass => 'My::Metaclass' );
731 Keep in mind that C<build_import_methods> will return an C<init_meta>
732 method for you, which you can also call from within your custom
735 my ( $import, $unimport, $init_meta ) =
736 Moose::Exporter->build_import_methods( ... );
743 $class->$import(...);
748 sub unimport { goto &$unimport }
755 $class->$init_meta(...);
760 =head1 METACLASS TRAITS
762 The C<import> method generated by C<Moose::Exporter> will allow the
763 user of your module to specify metaclass traits in a C<-traits>
764 parameter passed as part of the import:
766 use Moose -traits => 'My::Meta::Trait';
768 use Moose -traits => [ 'My::Meta::Trait', 'My::Other::Trait' ];
770 These traits will be applied to the caller's metaclass
771 instance. Providing traits for an exporting class that does not create
772 a metaclass for the caller is an error.
776 See L<Moose/BUGS> for details on reporting bugs.
780 Dave Rolsky E<lt>autarch@urth.orgE<gt>
782 This is largely a reworking of code in Moose.pm originally written by
783 Stevan Little and others.
785 =head1 COPYRIGHT AND LICENSE
787 Copyright 2009 by Infinity Interactive, Inc.
789 L<http://www.iinteractive.com>
791 This library is free software; you can redistribute it and/or modify
792 it under the same terms as Perl itself.