1 package Moose::Exporter;
6 our $VERSION = '0.89_02';
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 )
41 = $class->_make_sub_exporter_params(
42 [ @exports_from, $exporting_package ], $export_recorder );
44 my $exporter = Sub::Exporter::build_exporter(
47 groups => { default => [':all'] }
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;
125 for my $package ( @{$packages} ) {
126 my $args = $EXPORT_SPEC{$package}
127 or die "The $package package does not use Moose::Exporter\n";
129 for my $name ( @{ $args->{with_meta} } ) {
130 my $sub = $class->_sub_from_package( $package, $name )
133 my $fq_name = $package . '::' . $name;
135 $exports{$name} = $class->_make_wrapped_sub_with_meta(
141 $is_removable{$name} = 1;
144 for my $name ( @{ $args->{with_caller} } ) {
145 my $sub = $class->_sub_from_package( $package, $name )
148 my $fq_name = $package . '::' . $name;
150 $exports{$name} = $class->_make_wrapped_sub(
156 $is_removable{$name} = 1;
159 for my $name ( @{ $args->{as_is} } ) {
160 my ($sub, $coderef_name);
165 # Even though Moose re-exports things from Carp &
166 # Scalar::Util, we don't want to remove those at
167 # unimport time, because the importing package may
168 # have imported them explicitly ala
170 # use Carp qw( confess );
172 # This is a hack. Since we can't know whether they
173 # really want to keep these subs or not, we err on the
174 # safe side and leave them in.
176 ( $coderef_pkg, $coderef_name )
177 = Class::MOP::get_code_info($name);
179 $is_removable{$coderef_name} = $coderef_pkg eq $package ? 1 : 0;
182 $sub = $class->_sub_from_package( $package, $name )
185 $is_removable{$name} = 1;
186 $coderef_name = $name;
189 $export_recorder->{$sub} = 1;
191 $exports{$coderef_name} = sub {$sub};
195 return ( \%exports, \%is_removable );
198 sub _sub_from_package {
205 \&{ $package . '::' . $name };
208 return $sub if defined &$sub;
211 "Trying to export undefined sub ${package}::${name}";
218 sub _make_wrapped_sub {
222 my $export_recorder = shift;
224 # We need to set the package at import time, so that when
225 # package Foo imports has(), we capture "Foo" as the
226 # package. This lets other packages call Foo::has() and get
227 # the right package. This is done for backwards compatibility
228 # with existing production code, not because this is a good
231 my $caller = $CALLER;
233 my $wrapper = $self->_curry_wrapper($sub, $fq_name, $caller);
235 my $sub = subname($fq_name => $wrapper);
237 $export_recorder->{$sub} = 1;
243 sub _make_wrapped_sub_with_meta {
247 my $export_recorder = shift;
250 my $caller = $CALLER;
252 my $wrapper = $self->_late_curry_wrapper($sub, $fq_name,
253 sub { Class::MOP::class_of(shift) } => $caller);
255 my $sub = subname($fq_name => $wrapper);
257 $export_recorder->{$sub} = 1;
263 sub _make_wrapped_group {
265 my $package = shift; # package calling use Moose::Exporter
267 my $export_recorder = shift;
268 my $keywords = shift;
269 my $is_removable = shift;
272 my $caller = $CALLER; # package calling use PackageUsingMooseExporter -group => {args}
274 # there are plenty of ways to deal with telling the code which
275 # package it lives in. the last arg (collector hashref) is
276 # otherwise unused, so we'll stick the original package in
277 # there and act like 'with_caller' by putting the calling
278 # package name as the first arg
280 $_[3]{from} = $package;
282 my $named_code = $sub->(@_);
285 # send invalid return value error up to Sub::Exporter
286 unless (ref $named_code eq 'HASH') {
290 for my $name (keys %$named_code) {
291 my $code = $named_code->{$name};
293 my $fq_name = $package . '::' . $name;
294 my $wrapper = $class->_curry_wrapper(
300 my $sub = subname( $fq_name => $wrapper );
301 $named_code->{$name} = $sub;
303 # mark each coderef as ours
304 $keywords->{$name} = 1;
305 $is_removable->{$name} = 1;
306 $export_recorder->{$sub} = 1;
319 my $wrapper = sub { $sub->(@extra, @_) };
320 if (my $proto = prototype $sub) {
321 # XXX - Perl's prototype sucks. Use & to make set_prototype
322 # ignore the fact that we're passing "private variables"
323 &Scalar::Util::set_prototype($wrapper, $proto);
328 sub _late_curry_wrapper {
336 # resolve curried arguments at runtime via this closure
337 my @curry = ( $extra->( @ex_args ) );
338 return $sub->(@curry, @_);
341 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 _make_import_sub {
351 my $exporting_package = shift;
352 my $exporter = shift;
353 my $exports_from = shift;
354 my $export_to_main = shift;
358 # I think we could use Sub::Exporter's collector feature
359 # to do this, but that would be rather gross, since that
360 # feature isn't really designed to return a value to the
361 # caller of the exporter sub.
363 # Also, this makes sure we preserve backwards compat for
364 # _get_caller, so it always sees the arguments in the
367 ( $traits, @_ ) = _strip_traits(@_);
370 ( $metaclass, @_ ) = _strip_metaclass(@_);
371 $metaclass = Moose::Util::resolve_metaclass_alias(
372 'Class' => $metaclass
373 ) if defined $metaclass && length $metaclass;
375 # Normally we could look at $_[0], but in some weird cases
376 # (involving goto &Moose::import), $_[0] ends as something
377 # else (like Squirrel).
378 my $class = $exporting_package;
380 $CALLER = _get_caller(@_);
382 # this works because both pragmas set $^H (see perldoc
383 # perlvar) which affects the current compilation -
384 # i.e. the file who use'd us - which is why we don't need
385 # to do anything special to make it affect that file
386 # rather than this one (which is already compiled)
391 # we should never export to main
392 if ( $CALLER eq 'main' && !$export_to_main ) {
394 qq{$class does not export its sugar to the 'main' package.\n};
399 for my $c ( grep { $_->can('init_meta') } $class, @{$exports_from} ) {
400 # init_meta can apply a role, which when loaded uses
401 # Moose::Exporter, which in turn sets $CALLER, so we need
402 # to protect against that.
403 local $CALLER = $CALLER;
404 $c->init_meta( for_class => $CALLER, metaclass => $metaclass );
408 if ( $did_init_meta && @{$traits} ) {
409 # The traits will use Moose::Role, which in turn uses
410 # Moose::Exporter, which in turn sets $CALLER, so we need
411 # to protect against that.
412 local $CALLER = $CALLER;
413 _apply_meta_traits( $CALLER, $traits );
415 elsif ( @{$traits} ) {
418 "Cannot provide traits when $class does not have an init_meta() method"
428 my $idx = first_index { $_ eq '-traits' } @_;
430 return ( [], @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
432 my $traits = $_[ $idx + 1 ];
436 $traits = [ $traits ] unless ref $traits;
438 return ( $traits, @_ );
441 sub _strip_metaclass {
442 my $idx = first_index { $_ eq '-metaclass' } @_;
444 return ( undef, @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
446 my $metaclass = $_[ $idx + 1 ];
450 return ( $metaclass, @_ );
453 sub _apply_meta_traits {
454 my ( $class, $traits ) = @_;
456 return unless @{$traits};
458 my $meta = Class::MOP::class_of($class);
460 my $type = ( split /::/, ref $meta )[-1]
461 or Moose->throw_error(
462 'Cannot determine metaclass type for trait application . Meta isa '
467 ref $_ ? $_ : Moose::Util::resolve_metatrait_alias( $type => $_ )
471 return unless @resolved_traits;
473 Moose::Util::MetaRole::apply_metaclass_roles(
475 metaclass_roles => \@resolved_traits,
480 # 1 extra level because it's called by import so there's a layer
485 ( ref $_[1] && defined $_[1]->{into} ) ? $_[1]->{into}
486 : ( ref $_[1] && defined $_[1]->{into_level} )
487 ? caller( $offset + $_[1]->{into_level} )
491 sub _make_unimport_sub {
493 my $exporting_package = shift;
495 my $is_removable = shift;
496 my $export_recorder = shift;
499 my $caller = scalar caller();
500 Moose::Exporter->_remove_keywords(
502 [ keys %{$exports} ],
509 sub _remove_keywords {
512 my $keywords = shift;
513 my $is_removable = shift;
514 my $recorded_exports = shift;
518 foreach my $name ( @{ $keywords } ) {
519 next unless $is_removable->{$name};
521 if ( defined &{ $package . '::' . $name } ) {
522 my $sub = \&{ $package . '::' . $name };
524 # make sure it is from us
525 next unless $recorded_exports->{$sub};
527 # and if it is from us, then undef the slot
528 delete ${ $package . '::' }{$name};
533 sub _make_init_meta {
544 wrapped_method_metaclass
549 application_to_class_class
550 application_to_role_class
551 application_to_instance_class)
553 $metaclass_roles{$role} = $args->{$role} if exists $args->{$role};
556 my %base_class_roles;
557 %base_class_roles = ( roles => $args->{base_class_roles} )
558 if exists $args->{base_class_roles};
560 return unless %metaclass_roles || %base_class_roles;
566 return unless Class::MOP::class_of( $options{for_class} );
568 Moose::Util::MetaRole::apply_metaclass_roles(
569 for_class => $options{for_class},
573 Moose::Util::MetaRole::apply_base_class_roles(
574 for_class => $options{for_class},
577 if Class::MOP::class_of( $options{for_class} )
578 ->isa('Moose::Meta::Class');
580 return Class::MOP::class_of( $options{for_class} );
595 Moose::Exporter - make an import() and unimport() just like Moose.pm
599 package MyApp::Moose;
604 Moose::Exporter->setup_import_methods(
605 with_meta => [ 'has_rw', 'sugar2' ],
606 as_is => [ 'sugar3', \&Some::Random::thing ],
611 my ( $meta, $name, %options ) = @_;
612 $meta->add_attribute(
632 This module encapsulates the exporting of sugar functions in a
633 C<Moose.pm>-like manner. It does this by building custom C<import>,
634 C<unimport>, and C<init_meta> methods for your module, based on a spec you
637 It also lets you "stack" Moose-alike modules so you can export Moose's sugar
638 as well as your own, along with sugar from any random C<MooseX> module, as
639 long as they all use C<Moose::Exporter>. This feature exists to let you bundle
640 a set of MooseX modules into a policy module that developers can use directly
641 instead of using Moose itself.
643 To simplify writing exporter modules, C<Moose::Exporter> also imports
644 C<strict> and C<warnings> into your exporter module, as well as into
649 This module provides two public methods:
653 =item B<< Moose::Exporter->setup_import_methods(...) >>
655 When you call this method, C<Moose::Exporter> builds custom C<import>,
656 C<unimport>, and C<init_meta> methods for your module. The C<import> method
657 will export the functions you specify, and can also re-export functions
658 exported by some other module (like C<Moose.pm>).
660 The C<unimport> method cleans the caller's namespace of all the exported
663 If you pass any parameters for L<Moose::Util::MetaRole>, this method will
664 generate an C<init_meta> for you as well (see below for details). This
665 C<init_meta> will call C<Moose::Util::MetaRole::apply_metaclass_roles> and
666 C<Moose::Util::MetaRole::apply_base_class_roles> as needed.
668 Note that if any of these methods already exist, they will not be
669 overridden, you will have to use C<build_import_methods> to get the
670 coderef that would be installed.
672 This method accepts the following parameters:
676 =item * with_meta => [ ... ]
678 This list of function I<names only> will be wrapped and then exported. The
679 wrapper will pass the metaclass object for the caller as its first argument.
681 Many sugar functions will need to use this metaclass object to do something to
684 =item * as_is => [ ... ]
686 This list of function names or sub references will be exported as-is. You can
687 identify a subroutine by reference, which is handy to re-export some other
688 module's functions directly by reference (C<\&Some::Package::function>).
690 If you do export some other package's function, this function will never be
691 removed by the C<unimport> method. The reason for this is we cannot know if
692 the caller I<also> explicitly imported the sub themselves, and therefore wants
695 =item * also => $name or \@names
697 This is a list of modules which contain functions that the caller
698 wants to export. These modules must also use C<Moose::Exporter>. The
699 most common use case will be to export the functions from C<Moose.pm>.
700 Functions specified by C<with_meta> or C<as_is> take precedence over
701 functions exported by modules specified by C<also>, so that a module
702 can selectively override functions exported by another module.
704 C<Moose::Exporter> also makes sure all these functions get removed
705 when C<unimport> is called.
709 Any of the C<*_roles> options for
710 C<Moose::Util::MetaRole::apply_metaclass_roles> and
711 C<Moose::Util::MetaRole::base_class_roles> are also acceptable.
713 =item B<< Moose::Exporter->build_import_methods(...) >>
715 Returns two or three code refs, one for C<import>, one for
716 C<unimport>, and optionally one for C<init_meta>, if the appropriate
717 options are passed in.
719 Accepts the additional C<install> option, which accepts an arrayref of method
720 names to install into your exporting package. The valid options are C<import>,
721 C<unimport>, and C<init_meta>. Calling C<setup_import_methods> is equivalent
722 to calling C<build_import_methods> with C<< install => [qw(import unimport
723 init_meta)] >> except that it doesn't also return the methods.
725 Used by C<setup_import_methods>.
729 =head1 IMPORTING AND init_meta
731 If you want to set an alternative base object class or metaclass class, see
732 above for details on how this module can call L<Moose::Util::MetaRole> for
735 If you want to do something that is not supported by this module, simply
736 define an C<init_meta> method in your class. The C<import> method that
737 C<Moose::Exporter> generates for you will call this method (if it exists). It
738 will always pass the caller to this method via the C<for_class> parameter.
740 Most of the time, your C<init_meta> method will probably just call C<<
741 Moose->init_meta >> to do the real work:
744 shift; # our class name
745 return Moose->init_meta( @_, metaclass => 'My::Metaclass' );
748 Keep in mind that C<build_import_methods> will return an C<init_meta>
749 method for you, which you can also call from within your custom
752 my ( $import, $unimport, $init_meta ) =
753 Moose::Exporter->build_import_methods( ... );
760 $class->$import(...);
765 sub unimport { goto &$unimport }
772 $class->$init_meta(...);
777 =head1 METACLASS TRAITS
779 The C<import> method generated by C<Moose::Exporter> will allow the
780 user of your module to specify metaclass traits in a C<-traits>
781 parameter passed as part of the import:
783 use Moose -traits => 'My::Meta::Trait';
785 use Moose -traits => [ 'My::Meta::Trait', 'My::Other::Trait' ];
787 These traits will be applied to the caller's metaclass
788 instance. Providing traits for an exporting class that does not create
789 a metaclass for the caller is an error.
793 Dave Rolsky E<lt>autarch@urth.orgE<gt>
795 This is largely a reworking of code in Moose.pm originally written by
796 Stevan Little and others.
798 =head1 COPYRIGHT AND LICENSE
800 Copyright 2009 by Infinity Interactive, Inc.
802 L<http://www.iinteractive.com>
804 This library is free software; you can redistribute it and/or modify
805 it under the same terms as Perl itself.