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_caller} || [] },
133 @{ $args->{with_meta} || [] },
134 @{ $args->{as_is} || [] },
136 keys %{ $args->{groups} || {} }
139 for my $name ( @{ $args->{with_caller} } ) {
142 \&{ $package . '::' . $name };
145 if ( !defined(&$sub) ) {
147 "Trying to export undefined sub ${package}::${name}";
151 my $fq_name = $package . '::' . $name;
153 $exports{$name} = $class->_make_wrapped_sub(
159 $is_removable{$name} = 1;
162 for my $name ( @{ $args->{with_meta} } ) {
165 \&{ $package . '::' . $name };
168 if ( !defined(&$sub) ) {
170 "Trying to export undefined sub ${package}::${name}";
174 my $fq_name = $package . '::' . $name;
176 $exports{$name} = $class->_make_wrapped_sub_with_meta(
182 $is_removable{$name} = 1;
185 for my $name ( @{ $args->{as_is} } ) {
186 my ($sub, $coderef_name);
191 # Even though Moose re-exports things from Carp &
192 # Scalar::Util, we don't want to remove those at
193 # unimport time, because the importing package may
194 # have imported them explicitly ala
196 # use Carp qw( confess );
198 # This is a hack. Since we can't know whether they
199 # really want to keep these subs or not, we err on the
200 # safe side and leave them in.
202 ( $coderef_pkg, $coderef_name )
203 = Class::MOP::get_code_info($name);
205 $is_removable{$coderef_name} = $coderef_pkg eq $package ? 1 : 0;
210 \&{ $package . '::' . $name };
213 if ( !defined(&$sub) ) {
215 "Trying to export undefined sub ${package}::${name}";
219 $is_removable{$name} = 1;
220 $coderef_name = $name;
223 $export_recorder->{$sub} = 1;
225 $exports{$coderef_name} = sub {$sub};
228 for my $name ( keys %{ $args->{groups} } ) {
229 my $group = $args->{groups}{$name};
231 if (ref $group eq 'CODE') {
232 $groups{$name} = $class->_make_wrapped_group(
240 elsif (ref $group eq 'ARRAY') {
241 $groups{$name} = $group;
246 return ( \%exports, \%is_removable, \%groups );
251 sub _make_wrapped_sub {
255 my $export_recorder = shift;
257 # We need to set the package at import time, so that when
258 # package Foo imports has(), we capture "Foo" as the
259 # package. This lets other packages call Foo::has() and get
260 # the right package. This is done for backwards compatibility
261 # with existing production code, not because this is a good
264 my $caller = $CALLER;
266 my $wrapper = $self->_curry_wrapper($sub, $fq_name, $caller);
268 my $sub = subname($fq_name => $wrapper);
270 $export_recorder->{$sub} = 1;
276 sub _make_wrapped_sub_with_meta {
280 my $export_recorder = shift;
283 my $caller = $CALLER;
285 my $wrapper = $self->_late_curry_wrapper($sub, $fq_name,
286 sub { Class::MOP::class_of(shift) } => $caller);
288 my $sub = subname($fq_name => $wrapper);
290 $export_recorder->{$sub} = 1;
296 sub _make_wrapped_group {
298 my $package = shift; # package calling use Moose::Exporter
300 my $export_recorder = shift;
301 my $keywords = shift;
302 my $is_removable = shift;
305 my $caller = $CALLER; # package calling use PackageUsingMooseExporter -group => {args}
307 # there are plenty of ways to deal with telling the code which
308 # package it lives in. the last arg (collector hashref) is
309 # otherwise unused, so we'll stick the original package in
310 # there and act like 'with_caller' by putting the calling
311 # package name as the first arg
313 $_[3]{from} = $package;
315 my $named_code = $sub->(@_);
318 # send invalid return value error up to Sub::Exporter
319 unless (ref $named_code eq 'HASH') {
323 for my $name (keys %$named_code) {
324 my $code = $named_code->{$name};
326 my $fq_name = $package . '::' . $name;
327 my $wrapper = $class->_curry_wrapper(
333 my $sub = subname( $fq_name => $wrapper );
334 $named_code->{$name} = $sub;
336 # mark each coderef as ours
337 $keywords->{$name} = 1;
338 $is_removable->{$name} = 1;
339 $export_recorder->{$sub} = 1;
352 my $wrapper = sub { $sub->(@extra, @_) };
353 if (my $proto = prototype $sub) {
354 # XXX - Perl's prototype sucks. Use & to make set_prototype
355 # ignore the fact that we're passing "private variables"
356 &Scalar::Util::set_prototype($wrapper, $proto);
361 sub _late_curry_wrapper {
369 # resolve curried arguments at runtime via this closure
370 my @curry = ( $extra->( @ex_args ) );
371 return $sub->(@curry, @_);
374 if (my $proto = prototype $sub) {
375 # XXX - Perl's prototype sucks. Use & to make set_prototype
376 # ignore the fact that we're passing "private variables"
377 &Scalar::Util::set_prototype($wrapper, $proto);
382 sub _make_import_sub {
384 my $exporting_package = shift;
385 my $exporter = shift;
386 my $exports_from = shift;
387 my $export_to_main = shift;
391 # I think we could use Sub::Exporter's collector feature
392 # to do this, but that would be rather gross, since that
393 # feature isn't really designed to return a value to the
394 # caller of the exporter sub.
396 # Also, this makes sure we preserve backwards compat for
397 # _get_caller, so it always sees the arguments in the
400 ( $traits, @_ ) = _strip_traits(@_);
403 ( $metaclass, @_ ) = _strip_metaclass(@_);
404 $metaclass = Moose::Util::resolve_metaclass_alias(
405 'Class' => $metaclass
406 ) if defined $metaclass && length $metaclass;
408 # Normally we could look at $_[0], but in some weird cases
409 # (involving goto &Moose::import), $_[0] ends as something
410 # else (like Squirrel).
411 my $class = $exporting_package;
413 $CALLER = _get_caller(@_);
415 # this works because both pragmas set $^H (see perldoc
416 # perlvar) which affects the current compilation -
417 # i.e. the file who use'd us - which is why we don't need
418 # to do anything special to make it affect that file
419 # rather than this one (which is already compiled)
424 # we should never export to main
425 if ( $CALLER eq 'main' && !$export_to_main ) {
427 qq{$class does not export its sugar to the 'main' package.\n};
432 for my $c ( grep { $_->can('init_meta') } $class, @{$exports_from} ) {
433 # init_meta can apply a role, which when loaded uses
434 # Moose::Exporter, which in turn sets $CALLER, so we need
435 # to protect against that.
436 local $CALLER = $CALLER;
437 $c->init_meta( for_class => $CALLER, metaclass => $metaclass );
441 if ( $did_init_meta && @{$traits} ) {
442 # The traits will use Moose::Role, which in turn uses
443 # Moose::Exporter, which in turn sets $CALLER, so we need
444 # to protect against that.
445 local $CALLER = $CALLER;
446 _apply_meta_traits( $CALLER, $traits );
448 elsif ( @{$traits} ) {
451 "Cannot provide traits when $class does not have an init_meta() method"
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 _apply_meta_traits {
487 my ( $class, $traits ) = @_;
489 return unless @{$traits};
491 my $meta = Class::MOP::class_of($class);
493 my $type = ( split /::/, ref $meta )[-1]
494 or Moose->throw_error(
495 'Cannot determine metaclass type for trait application . Meta isa '
500 ref $_ ? $_ : Moose::Util::resolve_metatrait_alias( $type => $_ )
504 return unless @resolved_traits;
506 Moose::Util::MetaRole::apply_metaclass_roles(
508 metaclass_roles => \@resolved_traits,
513 # 1 extra level because it's called by import so there's a layer
518 ( ref $_[1] && defined $_[1]->{into} ) ? $_[1]->{into}
519 : ( ref $_[1] && defined $_[1]->{into_level} )
520 ? caller( $offset + $_[1]->{into_level} )
524 sub _make_unimport_sub {
526 my $exporting_package = shift;
528 my $is_removable = shift;
529 my $export_recorder = shift;
532 my $caller = scalar caller();
533 Moose::Exporter->_remove_keywords(
535 [ keys %{$exports} ],
542 sub _remove_keywords {
545 my $keywords = shift;
546 my $is_removable = shift;
547 my $recorded_exports = shift;
551 foreach my $name ( @{ $keywords } ) {
552 next unless $is_removable->{$name};
554 if ( defined &{ $package . '::' . $name } ) {
555 my $sub = \&{ $package . '::' . $name };
557 # make sure it is from us
558 next unless $recorded_exports->{$sub};
560 # and if it is from us, then undef the slot
561 delete ${ $package . '::' }{$name};
566 sub _make_init_meta {
577 wrapped_method_metaclass
582 application_to_class_class
583 application_to_role_class
584 application_to_instance_class)
586 $metaclass_roles{$role} = $args->{$role} if exists $args->{$role};
589 my %base_class_roles;
590 %base_class_roles = ( roles => $args->{base_class_roles} )
591 if exists $args->{base_class_roles};
593 return unless %metaclass_roles || %base_class_roles;
599 return unless Class::MOP::class_of( $options{for_class} );
601 Moose::Util::MetaRole::apply_metaclass_roles(
602 for_class => $options{for_class},
606 Moose::Util::MetaRole::apply_base_class_roles(
607 for_class => $options{for_class},
610 if Class::MOP::class_of( $options{for_class} )
611 ->isa('Moose::Meta::Class');
613 return Class::MOP::class_of( $options{for_class} );
628 Moose::Exporter - make an import() and unimport() just like Moose.pm
632 package MyApp::Moose;
637 Moose::Exporter->setup_import_methods(
638 with_caller => [ 'has_rw', 'sugar2' ],
639 as_is => [ 'sugar3', \&Some::Random::thing ],
644 my ($caller, $name, %options) = @_;
645 Class::MOP::class_of($caller)->add_attribute($name,
664 This module encapsulates the exporting of sugar functions in a
665 C<Moose.pm>-like manner. It does this by building custom C<import>,
666 C<unimport>, and C<init_meta> methods for your module, based on a spec you
669 It also lets you "stack" Moose-alike modules so you can export Moose's sugar
670 as well as your own, along with sugar from any random C<MooseX> module, as
671 long as they all use C<Moose::Exporter>. This feature exists to let you bundle
672 a set of MooseX modules into a policy module that developers can use directly
673 instead of using Moose itself.
675 To simplify writing exporter modules, C<Moose::Exporter> also imports
676 C<strict> and C<warnings> into your exporter module, as well as into
681 This module provides two public methods:
685 =item B<< Moose::Exporter->setup_import_methods(...) >>
687 When you call this method, C<Moose::Exporter> builds custom C<import>,
688 C<unimport>, and C<init_meta> methods for your module. The C<import> method
689 will export the functions you specify, and can also re-export functions
690 exported by some other module (like C<Moose.pm>).
692 The C<unimport> method cleans the caller's namespace of all the exported
695 If you pass any parameters for L<Moose::Util::MetaRole>, this method will
696 generate an C<init_meta> for you as well (see below for details). This
697 C<init_meta> will call C<Moose::Util::MetaRole::apply_metaclass_roles> and
698 C<Moose::Util::MetaRole::apply_base_class_roles> as needed.
700 Note that if any of these methods already exist, they will not be
701 overridden, you will have to use C<build_import_methods> to get the
702 coderef that would be installed.
704 This method accepts the following parameters:
708 =item * with_caller => [ ... ]
710 This list of function I<names only> will be wrapped and then exported. The
711 wrapper will pass the name of the calling package as the first argument to the
712 function. Many sugar functions need to know their caller so they can get the
713 calling package's metaclass object.
715 =item * as_is => [ ... ]
717 This list of function names or sub references will be exported as-is. You can
718 identify a subroutine by reference, which is handy to re-export some other
719 module's functions directly by reference (C<\&Some::Package::function>).
721 If you do export some other package's function, this function will never be
722 removed by the C<unimport> method. The reason for this is we cannot know if
723 the caller I<also> explicitly imported the sub themselves, and therefore wants
726 =item * also => $name or \@names
728 This is a list of modules which contain functions that the caller
729 wants to export. These modules must also use C<Moose::Exporter>. The
730 most common use case will be to export the functions from C<Moose.pm>.
731 Functions specified by C<with_caller> or C<as_is> take precedence over
732 functions exported by modules specified by C<also>, so that a module
733 can selectively override functions exported by another module.
735 C<Moose::Exporter> also makes sure all these functions get removed
736 when C<unimport> is called.
740 Any of the C<*_roles> options for
741 C<Moose::Util::MetaRole::apply_metaclass_roles> and
742 C<Moose::Util::MetaRole::base_class_roles> are also acceptable.
744 =item B<< Moose::Exporter->build_import_methods(...) >>
746 Returns two or three code refs, one for C<import>, one for
747 C<unimport>, and optionally one for C<init_meta>, if the appropriate
748 options are passed in.
750 Accepts the additional C<install> option, which accepts an arrayref of method
751 names to install into your exporting package. The valid options are C<import>,
752 C<unimport>, and C<init_meta>. Calling C<setup_import_methods> is equivalent
753 to calling C<build_import_methods> with C<< install => [qw(import unimport
754 init_meta)] >> except that it doesn't also return the methods.
756 Used by C<setup_import_methods>.
760 =head1 IMPORTING AND init_meta
762 If you want to set an alternative base object class or metaclass class, see
763 above for details on how this module can call L<Moose::Util::MetaRole> for
766 If you want to do something that is not supported by this module, simply
767 define an C<init_meta> method in your class. The C<import> method that
768 C<Moose::Exporter> generates for you will call this method (if it exists). It
769 will always pass the caller to this method via the C<for_class> parameter.
771 Most of the time, your C<init_meta> method will probably just call C<<
772 Moose->init_meta >> to do the real work:
775 shift; # our class name
776 return Moose->init_meta( @_, metaclass => 'My::Metaclass' );
779 Keep in mind that C<build_import_methods> will return an C<init_meta>
780 method for you, which you can also call from within your custom
783 my ( $import, $unimport, $init_meta ) =
784 Moose::Exporter->build_import_methods( ... );
791 $class->$import(...);
796 sub unimport { goto &$unimport }
803 $class->$init_meta(...);
808 =head1 METACLASS TRAITS
810 The C<import> method generated by C<Moose::Exporter> will allow the
811 user of your module to specify metaclass traits in a C<-traits>
812 parameter passed as part of the import:
814 use Moose -traits => 'My::Meta::Trait';
816 use Moose -traits => [ 'My::Meta::Trait', 'My::Other::Trait' ];
818 These traits will be applied to the caller's metaclass
819 instance. Providing traits for an exporting class that does not create
820 a metaclass for the caller is an error.
824 Dave Rolsky E<lt>autarch@urth.orgE<gt>
826 This is largely a reworking of code in Moose.pm originally written by
827 Stevan Little and others.
829 =head1 COPYRIGHT AND LICENSE
831 Copyright 2009 by Infinity Interactive, Inc.
833 L<http://www.iinteractive.com>
835 This library is free software; you can redistribute it and/or modify
836 it under the same terms as Perl itself.