1 package Moose::Exporter;
6 our $VERSION = '0.89_01';
7 $VERSION = eval $VERSION;
8 our $AUTHORITY = 'cpan:STEVAN';
11 use List::MoreUtils qw( first_index uniq );
12 use Moose::Util::MetaRole;
13 use Sub::Exporter 0.980;
14 use Sub::Name qw(subname);
18 sub setup_import_methods {
19 my ( $class, %args ) = @_;
21 my $exporting_package = $args{exporting_package} ||= caller();
23 $class->build_import_methods(
25 install => [qw(import unimport init_meta)]
29 sub build_import_methods {
30 my ( $class, %args ) = @_;
32 my $exporting_package = $args{exporting_package} ||= caller();
34 $EXPORT_SPEC{$exporting_package} = \%args;
36 my @exports_from = $class->_follow_also( $exporting_package );
38 my $export_recorder = {};
40 my ( $exports, $is_removable, $groups )
41 = $class->_make_sub_exporter_params(
42 [ @exports_from, $exporting_package ], $export_recorder );
44 my $exporter = Sub::Exporter::build_exporter(
47 groups => { default => [':all'], %$groups }
52 # $args{_export_to_main} exists for backwards compat, because
53 # Moose::Util::TypeConstraints did export to main (unlike Moose &
55 $methods{import} = $class->_make_import_sub( $exporting_package,
56 $exporter, \@exports_from, $args{_export_to_main} );
58 $methods{unimport} = $class->_make_unimport_sub( $exporting_package,
59 $exports, $is_removable, $export_recorder );
61 $methods{init_meta} = $class->_make_init_meta( $exporting_package,
64 my $package = Class::MOP::Package->initialize($exporting_package);
65 for my $to_install ( @{ $args{install} || [] } ) {
66 my $symbol = '&' . $to_install;
68 unless $methods{$to_install}
69 && !$package->has_package_symbol($symbol);
70 $package->add_package_symbol( $symbol, $methods{$to_install} );
73 return ( $methods{import}, $methods{unimport}, $methods{init_meta} )
81 my $exporting_package = shift;
83 local %$seen = ( $exporting_package => 1 );
85 return uniq( _follow_also_real($exporting_package) );
88 sub _follow_also_real {
89 my $exporting_package = shift;
91 if (!exists $EXPORT_SPEC{$exporting_package}) {
92 my $loaded = Class::MOP::is_class_loaded($exporting_package);
94 die "Package in also ($exporting_package) does not seem to "
95 . "use Moose::Exporter"
96 . ($loaded ? "" : " (is it loaded?)");
99 my $also = $EXPORT_SPEC{$exporting_package}{also};
101 return unless defined $also;
103 my @also = ref $also ? @{$also} : $also;
105 for my $package (@also)
107 die "Circular reference in also parameter to Moose::Exporter between $exporting_package and $package"
108 if $seen->{$package};
110 $seen->{$package} = 1;
113 return @also, map { _follow_also_real($_) } @also;
117 sub _make_sub_exporter_params {
119 my $packages = shift;
120 my $export_recorder = shift;
126 for my $package ( @{$packages} ) {
127 my $args = $EXPORT_SPEC{$package}
128 or die "The $package package does not use Moose::Exporter\n";
130 # one group for each 'also' package
131 $groups{$package} = [
132 @{ $args->{with_meta} || [] },
133 @{ $args->{with_caller} || [] },
134 @{ $args->{as_is} || [] },
137 keys %{ $args->{groups} || {} }
141 for my $name ( @{ $args->{with_meta} } ) {
144 \&{ $package . '::' . $name };
147 my $fq_name = $package . '::' . $name;
149 $exports{$name} = $class->_make_wrapped_sub_with_meta(
155 $is_removable{$name} = 1;
158 for my $name ( @{ $args->{with_caller} } ) {
161 \&{ $package . '::' . $name };
164 my $fq_name = $package . '::' . $name;
166 $exports{$name} = $class->_make_wrapped_sub(
172 $is_removable{$name} = 1;
175 for my $name ( @{ $args->{as_is} } ) {
181 # Even though Moose re-exports things from Carp &
182 # Scalar::Util, we don't want to remove those at
183 # unimport time, because the importing package may
184 # have imported them explicitly ala
186 # use Carp qw( confess );
188 # This is a hack. Since we can't know whether they
189 # really want to keep these subs or not, we err on the
190 # safe side and leave them in.
192 ( $coderef_pkg, $name ) = Class::MOP::get_code_info($name);
194 $is_removable{$name} = $coderef_pkg eq $package ? 1 : 0;
199 \&{ $package . '::' . $name };
202 $is_removable{$name} = 1;
205 $export_recorder->{$sub} = 1;
207 $exports{$name} = sub {$sub};
210 for my $name ( keys %{ $args->{groups} } ) {
211 my $group = $args->{groups}{$name};
213 if (ref $group eq 'CODE') {
214 $groups{$name} = $class->_make_wrapped_group(
222 elsif (ref $group eq 'ARRAY') {
223 $groups{$name} = $group;
228 return ( \%exports, \%is_removable, \%groups );
233 sub _make_wrapped_sub {
237 my $export_recorder = shift;
239 # We need to set the package at import time, so that when
240 # package Foo imports has(), we capture "Foo" as the
241 # package. This lets other packages call Foo::has() and get
242 # the right package. This is done for backwards compatibility
243 # with existing production code, not because this is a good
246 my $caller = $CALLER;
248 my $wrapper = $self->_curry_wrapper($sub, $fq_name, $caller);
250 my $sub = subname($fq_name => $wrapper);
252 $export_recorder->{$sub} = 1;
258 sub _make_wrapped_sub_with_meta {
262 my $export_recorder = shift;
265 my $caller = $CALLER;
267 my $wrapper = $self->_late_curry_wrapper($sub, $fq_name,
268 sub { Class::MOP::class_of(shift) } => $caller);
270 my $sub = subname($fq_name => $wrapper);
272 $export_recorder->{$sub} = 1;
278 sub _make_wrapped_group {
280 my $package = shift; # package calling use Moose::Exporter
282 my $export_recorder = shift;
283 my $keywords = shift;
284 my $is_removable = shift;
287 my $caller = $CALLER; # package calling use PackageUsingMooseExporter -group => {args}
289 # there are plenty of ways to deal with telling the code which
290 # package it lives in. the last arg (collector hashref) is
291 # otherwise unused, so we'll stick the original package in
292 # there and act like 'with_caller' by putting the calling
293 # package name as the first arg
295 $_[3]{from} = $package;
297 my $named_code = $sub->(@_);
300 # send invalid return value error up to Sub::Exporter
301 unless (ref $named_code eq 'HASH') {
305 for my $name (keys %$named_code) {
306 my $code = $named_code->{$name};
308 my $fq_name = $package . '::' . $name;
309 my $wrapper = $class->_curry_wrapper(
315 my $sub = subname( $fq_name => $wrapper );
316 $named_code->{$name} = $sub;
318 # mark each coderef as ours
319 $keywords->{$name} = 1;
320 $is_removable->{$name} = 1;
321 $export_recorder->{$sub} = 1;
334 my $wrapper = sub { $sub->(@extra, @_) };
335 if (my $proto = prototype $sub) {
336 # XXX - Perl's prototype sucks. Use & to make set_prototype
337 # ignore the fact that we're passing "private variables"
338 &Scalar::Util::set_prototype($wrapper, $proto);
343 sub _late_curry_wrapper {
351 # resolve curried arguments at runtime via this closure
352 my @curry = ( $extra->( @ex_args ) );
353 return $sub->(@curry, @_);
356 if (my $proto = prototype $sub) {
357 # XXX - Perl's prototype sucks. Use & to make set_prototype
358 # ignore the fact that we're passing "private variables"
359 &Scalar::Util::set_prototype($wrapper, $proto);
364 sub _make_import_sub {
366 my $exporting_package = shift;
367 my $exporter = shift;
368 my $exports_from = shift;
369 my $export_to_main = shift;
373 # I think we could use Sub::Exporter's collector feature
374 # to do this, but that would be rather gross, since that
375 # feature isn't really designed to return a value to the
376 # caller of the exporter sub.
378 # Also, this makes sure we preserve backwards compat for
379 # _get_caller, so it always sees the arguments in the
382 ( $traits, @_ ) = _strip_traits(@_);
385 ( $metaclass, @_ ) = _strip_metaclass(@_);
386 $metaclass = Moose::Util::resolve_metaclass_alias(
387 'Class' => $metaclass
388 ) if defined $metaclass && length $metaclass;
390 # Normally we could look at $_[0], but in some weird cases
391 # (involving goto &Moose::import), $_[0] ends as something
392 # else (like Squirrel).
393 my $class = $exporting_package;
395 $CALLER = _get_caller(@_);
397 # this works because both pragmas set $^H (see perldoc
398 # perlvar) which affects the current compilation -
399 # i.e. the file who use'd us - which is why we don't need
400 # to do anything special to make it affect that file
401 # rather than this one (which is already compiled)
406 # we should never export to main
407 if ( $CALLER eq 'main' && !$export_to_main ) {
409 qq{$class does not export its sugar to the 'main' package.\n};
414 for my $c ( grep { $_->can('init_meta') } $class, @{$exports_from} ) {
415 # init_meta can apply a role, which when loaded uses
416 # Moose::Exporter, which in turn sets $CALLER, so we need
417 # to protect against that.
418 local $CALLER = $CALLER;
419 $c->init_meta( for_class => $CALLER, metaclass => $metaclass );
423 if ( $did_init_meta && @{$traits} ) {
424 # The traits will use Moose::Role, which in turn uses
425 # Moose::Exporter, which in turn sets $CALLER, so we need
426 # to protect against that.
427 local $CALLER = $CALLER;
428 _apply_meta_traits( $CALLER, $traits );
430 elsif ( @{$traits} ) {
433 "Cannot provide traits when $class does not have an init_meta() method"
443 my $idx = first_index { $_ eq '-traits' } @_;
445 return ( [], @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
447 my $traits = $_[ $idx + 1 ];
451 $traits = [ $traits ] unless ref $traits;
453 return ( $traits, @_ );
456 sub _strip_metaclass {
457 my $idx = first_index { $_ eq '-metaclass' } @_;
459 return ( undef, @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
461 my $metaclass = $_[ $idx + 1 ];
465 return ( $metaclass, @_ );
468 sub _apply_meta_traits {
469 my ( $class, $traits ) = @_;
471 return unless @{$traits};
473 my $meta = Class::MOP::class_of($class);
475 my $type = ( split /::/, ref $meta )[-1]
476 or Moose->throw_error(
477 'Cannot determine metaclass type for trait application . Meta isa '
482 ref $_ ? $_ : Moose::Util::resolve_metatrait_alias( $type => $_ )
486 return unless @resolved_traits;
488 Moose::Util::MetaRole::apply_metaclass_roles(
490 metaclass_roles => \@resolved_traits,
495 # 1 extra level because it's called by import so there's a layer
500 ( ref $_[1] && defined $_[1]->{into} ) ? $_[1]->{into}
501 : ( ref $_[1] && defined $_[1]->{into_level} )
502 ? caller( $offset + $_[1]->{into_level} )
506 sub _make_unimport_sub {
508 my $exporting_package = shift;
510 my $is_removable = shift;
511 my $export_recorder = shift;
514 my $caller = scalar caller();
515 Moose::Exporter->_remove_keywords(
517 [ keys %{$exports} ],
524 sub _remove_keywords {
527 my $keywords = shift;
528 my $is_removable = shift;
529 my $recorded_exports = shift;
533 foreach my $name ( @{ $keywords } ) {
534 next unless $is_removable->{$name};
536 if ( defined &{ $package . '::' . $name } ) {
537 my $sub = \&{ $package . '::' . $name };
539 # make sure it is from us
540 next unless $recorded_exports->{$sub};
542 # and if it is from us, then undef the slot
543 delete ${ $package . '::' }{$name};
548 sub _make_init_meta {
559 wrapped_method_metaclass
564 application_to_class_class
565 application_to_role_class
566 application_to_instance_class)
568 $metaclass_roles{$role} = $args->{$role} if exists $args->{$role};
571 my %base_class_roles;
572 %base_class_roles = ( roles => $args->{base_class_roles} )
573 if exists $args->{base_class_roles};
575 return unless %metaclass_roles || %base_class_roles;
581 return unless Class::MOP::class_of( $options{for_class} );
583 Moose::Util::MetaRole::apply_metaclass_roles(
584 for_class => $options{for_class},
588 Moose::Util::MetaRole::apply_base_class_roles(
589 for_class => $options{for_class},
592 if Class::MOP::class_of( $options{for_class} )
593 ->isa('Moose::Meta::Class');
595 return Class::MOP::class_of( $options{for_class} );
610 Moose::Exporter - make an import() and unimport() just like Moose.pm
614 package MyApp::Moose;
619 Moose::Exporter->setup_import_methods(
620 with_meta => [ 'has_rw', 'sugar2' ],
621 as_is => [ 'sugar3', \&Some::Random::thing ],
626 my ( $meta, $name, %options ) = @_;
627 $meta->add_attribute(
647 This module encapsulates the exporting of sugar functions in a
648 C<Moose.pm>-like manner. It does this by building custom C<import>,
649 C<unimport>, and C<init_meta> methods for your module, based on a spec you
652 It also lets you "stack" Moose-alike modules so you can export Moose's sugar
653 as well as your own, along with sugar from any random C<MooseX> module, as
654 long as they all use C<Moose::Exporter>. This feature exists to let you bundle
655 a set of MooseX modules into a policy module that developers can use directly
656 instead of using Moose itself.
658 To simplify writing exporter modules, C<Moose::Exporter> also imports
659 C<strict> and C<warnings> into your exporter module, as well as into
664 This module provides two public methods:
668 =item B<< Moose::Exporter->setup_import_methods(...) >>
670 When you call this method, C<Moose::Exporter> builds custom C<import>,
671 C<unimport>, and C<init_meta> methods for your module. The C<import> method
672 will export the functions you specify, and can also re-export functions
673 exported by some other module (like C<Moose.pm>).
675 The C<unimport> method cleans the caller's namespace of all the exported
678 If you pass any parameters for L<Moose::Util::MetaRole>, this method will
679 generate an C<init_meta> for you as well (see below for details). This
680 C<init_meta> will call C<Moose::Util::MetaRole::apply_metaclass_roles> and
681 C<Moose::Util::MetaRole::apply_base_class_roles> as needed.
683 Note that if any of these methods already exist, they will not be
684 overridden, you will have to use C<build_import_methods> to get the
685 coderef that would be installed.
687 This method accepts the following parameters:
691 =item * with_meta => [ ... ]
693 This list of function I<names only> will be wrapped and then exported. The
694 wrapper will pass the metaclass object for the caller as its first argument.
696 Many sugar functions will need to use this metaclass object to do something to
699 =item * as_is => [ ... ]
701 This list of function names or sub references will be exported as-is. You can
702 identify a subroutine by reference, which is handy to re-export some other
703 module's functions directly by reference (C<\&Some::Package::function>).
705 If you do export some other package's function, this function will never be
706 removed by the C<unimport> method. The reason for this is we cannot know if
707 the caller I<also> explicitly imported the sub themselves, and therefore wants
710 =item * also => $name or \@names
712 This is a list of modules which contain functions that the caller
713 wants to export. These modules must also use C<Moose::Exporter>. The
714 most common use case will be to export the functions from C<Moose.pm>.
715 Functions specified by C<with_meta> or C<as_is> take precedence over
716 functions exported by modules specified by C<also>, so that a module
717 can selectively override functions exported by another module.
719 C<Moose::Exporter> also makes sure all these functions get removed
720 when C<unimport> is called.
724 Any of the C<*_roles> options for
725 C<Moose::Util::MetaRole::apply_metaclass_roles> and
726 C<Moose::Util::MetaRole::base_class_roles> are also acceptable.
728 =item B<< Moose::Exporter->build_import_methods(...) >>
730 Returns two or three code refs, one for C<import>, one for
731 C<unimport>, and optionally one for C<init_meta>, if the appropriate
732 options are passed in.
734 Accepts the additional C<install> option, which accepts an arrayref of method
735 names to install into your exporting package. The valid options are C<import>,
736 C<unimport>, and C<init_meta>. Calling C<setup_import_methods> is equivalent
737 to calling C<build_import_methods> with C<< install => [qw(import unimport
738 init_meta)] >> except that it doesn't also return the methods.
740 Used by C<setup_import_methods>.
744 =head1 IMPORTING AND init_meta
746 If you want to set an alternative base object class or metaclass class, see
747 above for details on how this module can call L<Moose::Util::MetaRole> for
750 If you want to do something that is not supported by this module, simply
751 define an C<init_meta> method in your class. The C<import> method that
752 C<Moose::Exporter> generates for you will call this method (if it exists). It
753 will always pass the caller to this method via the C<for_class> parameter.
755 Most of the time, your C<init_meta> method will probably just call C<<
756 Moose->init_meta >> to do the real work:
759 shift; # our class name
760 return Moose->init_meta( @_, metaclass => 'My::Metaclass' );
763 Keep in mind that C<build_import_methods> will return an C<init_meta>
764 method for you, which you can also call from within your custom
767 my ( $import, $unimport, $init_meta ) =
768 Moose::Exporter->build_import_methods( ... );
775 $class->$import(...);
780 sub unimport { goto &$unimport }
787 $class->$init_meta(...);
792 =head1 METACLASS TRAITS
794 The C<import> method generated by C<Moose::Exporter> will allow the
795 user of your module to specify metaclass traits in a C<-traits>
796 parameter passed as part of the import:
798 use Moose -traits => 'My::Meta::Trait';
800 use Moose -traits => [ 'My::Meta::Trait', 'My::Other::Trait' ];
802 These traits will be applied to the caller's metaclass
803 instance. Providing traits for an exporting class that does not create
804 a metaclass for the caller is an error.
808 Dave Rolsky E<lt>autarch@urth.orgE<gt>
810 This is largely a reworking of code in Moose.pm originally written by
811 Stevan Little and others.
813 =head1 COPYRIGHT AND LICENSE
815 Copyright 2009 by Infinity Interactive, Inc.
817 L<http://www.iinteractive.com>
819 This library is free software; you can redistribute it and/or modify
820 it under the same terms as Perl itself.