1 package Moose::Exporter;
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 = $class->_make_sub_exporter_params(
41 [ @exports_from, $exporting_package ], $export_recorder,
44 my $exporter = Sub::Exporter::build_exporter(
47 groups => { default => [':all'] }
52 $methods{import} = $class->_make_import_sub( $exporting_package,
53 $exporter, \@exports_from );
55 $methods{unimport} = $class->_make_unimport_sub( $exporting_package,
56 $exports, $export_recorder );
58 $methods{init_meta} = $class->_make_init_meta( $exporting_package,
61 my $package = Class::MOP::Package->initialize($exporting_package);
62 for my $to_install ( @{ $args{install} || [] } ) {
63 my $symbol = '&' . $to_install;
65 unless $methods{$to_install}
66 && !$package->has_package_symbol($symbol);
67 $package->add_package_symbol( $symbol, $methods{$to_install} );
70 return ( $methods{import}, $methods{unimport}, $methods{init_meta} )
78 my $exporting_package = shift;
80 local %$seen = ( $exporting_package => 1 );
82 return uniq( _follow_also_real($exporting_package) );
85 sub _follow_also_real {
86 my $exporting_package = shift;
88 if (!exists $EXPORT_SPEC{$exporting_package}) {
89 my $loaded = Class::MOP::is_class_loaded($exporting_package);
91 die "Package in also ($exporting_package) does not seem to "
92 . "use Moose::Exporter"
93 . ($loaded ? "" : " (is it loaded?)");
96 my $also = $EXPORT_SPEC{$exporting_package}{also};
98 return unless defined $also;
100 my @also = ref $also ? @{$also} : $also;
102 for my $package (@also)
104 die "Circular reference in 'also' parameter to Moose::Exporter between $exporting_package and $package"
105 if $seen->{$package};
107 $seen->{$package} = 1;
110 return @also, map { _follow_also_real($_) } @also;
114 sub _make_sub_exporter_params {
116 my $packages = shift;
117 my $export_recorder = shift;
121 for my $package ( @{$packages} ) {
122 my $args = $EXPORT_SPEC{$package}
123 or die "The $package package does not use Moose::Exporter\n";
125 for my $name ( @{ $args->{with_meta} } ) {
126 my $sub = $class->_sub_from_package( $package, $name )
129 my $fq_name = $package . '::' . $name;
131 $exports{$name} = $class->_make_wrapped_sub_with_meta(
138 for my $name ( @{ $args->{with_caller} } ) {
139 my $sub = $class->_sub_from_package( $package, $name )
142 my $fq_name = $package . '::' . $name;
144 $exports{$name} = $class->_make_wrapped_sub(
151 for my $name ( @{ $args->{as_is} } ) {
152 my ($sub, $coderef_name);
158 ( $coderef_pkg, $coderef_name )
159 = Class::MOP::get_code_info($name);
161 # Moose re-exports things from Carp and Scalar::Util. Usually,
162 # we want to remove those again at unimport time. However, the
163 # importing package might have imported those symbols
164 # explicitly after using Moose ala
167 # use Carp qw( confess );
169 # In this case, we don't want to remove 'confess' when
170 # unimporting. To do that, we wrap the exports from other
171 # packages in anonymous coderef. Then, at unimport time, we
172 # can figure out if the package symbol still contains the
173 # coderef we exported, or if the user overwrote it with
174 # something else we don't want to remove.
175 if ( $coderef_pkg ne $package ) {
176 $sub = sub { goto &$name };
177 &Scalar::Util::set_prototype( $sub, prototype $name );
181 $sub = $class->_sub_from_package( $package, $name )
184 $coderef_name = $name;
187 $export_recorder->{$sub} = 1;
189 $exports{$coderef_name} = sub { $sub };
196 sub _sub_from_package {
203 \&{ $package . '::' . $name };
206 return $sub if defined &$sub;
209 "Trying to export undefined sub ${package}::${name}";
216 sub _make_wrapped_sub {
220 my $export_recorder = shift;
222 # We need to set the package at import time, so that when
223 # package Foo imports has(), we capture "Foo" as the
224 # package. This lets other packages call Foo::has() and get
225 # the right package. This is done for backwards compatibility
226 # with existing production code, not because this is a good
229 my $caller = $CALLER;
231 my $wrapper = $self->_curry_wrapper($sub, $fq_name, $caller);
233 my $sub = subname($fq_name => $wrapper);
235 $export_recorder->{$sub} = 1;
241 sub _make_wrapped_sub_with_meta {
245 my $export_recorder = shift;
248 my $caller = $CALLER;
250 my $wrapper = $self->_late_curry_wrapper($sub, $fq_name,
251 sub { Class::MOP::class_of(shift) } => $caller);
253 my $sub = subname($fq_name => $wrapper);
255 $export_recorder->{$sub} = 1;
267 my $wrapper = sub { $sub->(@extra, @_) };
268 if (my $proto = prototype $sub) {
269 # XXX - Perl's prototype sucks. Use & to make set_prototype
270 # ignore the fact that we're passing "private variables"
271 &Scalar::Util::set_prototype($wrapper, $proto);
276 sub _late_curry_wrapper {
284 # resolve curried arguments at runtime via this closure
285 my @curry = ( $extra->( @ex_args ) );
286 return $sub->(@curry, @_);
289 if (my $proto = prototype $sub) {
290 # XXX - Perl's prototype sucks. Use & to make set_prototype
291 # ignore the fact that we're passing "private variables"
292 &Scalar::Util::set_prototype($wrapper, $proto);
297 sub _make_import_sub {
299 my $exporting_package = shift;
300 my $exporter = shift;
301 my $exports_from = shift;
305 # I think we could use Sub::Exporter's collector feature
306 # to do this, but that would be rather gross, since that
307 # feature isn't really designed to return a value to the
308 # caller of the exporter sub.
310 # Also, this makes sure we preserve backwards compat for
311 # _get_caller, so it always sees the arguments in the
314 ( $traits, @_ ) = _strip_traits(@_);
317 ( $metaclass, @_ ) = _strip_metaclass(@_);
318 $metaclass = Moose::Util::resolve_metaclass_alias(
319 'Class' => $metaclass
320 ) if defined $metaclass && length $metaclass;
322 # Normally we could look at $_[0], but in some weird cases
323 # (involving goto &Moose::import), $_[0] ends as something
324 # else (like Squirrel).
325 my $class = $exporting_package;
327 $CALLER = _get_caller(@_);
329 # this works because both pragmas set $^H (see perldoc
330 # perlvar) which affects the current compilation -
331 # i.e. the file who use'd us - which is why we don't need
332 # to do anything special to make it affect that file
333 # rather than this one (which is already compiled)
339 for my $c ( grep { $_->can('init_meta') } $class, @{$exports_from} ) {
340 # init_meta can apply a role, which when loaded uses
341 # Moose::Exporter, which in turn sets $CALLER, so we need
342 # to protect against that.
343 local $CALLER = $CALLER;
344 $c->init_meta( for_class => $CALLER, metaclass => $metaclass );
348 if ( $did_init_meta && @{$traits} ) {
349 # The traits will use Moose::Role, which in turn uses
350 # Moose::Exporter, which in turn sets $CALLER, so we need
351 # to protect against that.
352 local $CALLER = $CALLER;
353 _apply_meta_traits( $CALLER, $traits );
355 elsif ( @{$traits} ) {
358 "Cannot provide traits when $class does not have an init_meta() method"
368 my $idx = first_index { $_ eq '-traits' } @_;
370 return ( [], @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
372 my $traits = $_[ $idx + 1 ];
376 $traits = [ $traits ] unless ref $traits;
378 return ( $traits, @_ );
381 sub _strip_metaclass {
382 my $idx = first_index { $_ eq '-metaclass' } @_;
384 return ( undef, @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
386 my $metaclass = $_[ $idx + 1 ];
390 return ( $metaclass, @_ );
393 sub _apply_meta_traits {
394 my ( $class, $traits ) = @_;
396 return unless @{$traits};
398 my $meta = Class::MOP::class_of($class);
400 my $type = ( split /::/, ref $meta )[-1]
401 or Moose->throw_error(
402 'Cannot determine metaclass type for trait application . Meta isa '
407 ref $_ ? $_ : Moose::Util::resolve_metatrait_alias( $type => $_ )
411 return unless @resolved_traits;
413 Moose::Util::MetaRole::apply_metaclass_roles(
415 metaclass_roles => \@resolved_traits,
420 # 1 extra level because it's called by import so there's a layer
425 ( ref $_[1] && defined $_[1]->{into} ) ? $_[1]->{into}
426 : ( ref $_[1] && defined $_[1]->{into_level} )
427 ? caller( $offset + $_[1]->{into_level} )
431 sub _make_unimport_sub {
433 my $exporting_package = shift;
435 my $export_recorder = shift;
438 my $caller = scalar caller();
439 Moose::Exporter->_remove_keywords(
441 [ keys %{$exports} ],
447 sub _remove_keywords {
450 my $keywords = shift;
451 my $recorded_exports = shift;
455 foreach my $name ( @{ $keywords } ) {
456 if ( defined &{ $package . '::' . $name } ) {
457 my $sub = \&{ $package . '::' . $name };
459 # make sure it is from us
460 next unless $recorded_exports->{$sub};
462 # and if it is from us, then undef the slot
463 delete ${ $package . '::' }{$name};
468 sub _make_init_meta {
479 wrapped_method_metaclass
484 application_to_class_class
485 application_to_role_class
486 application_to_instance_class)
488 $metaclass_roles{$role} = $args->{$role} if exists $args->{$role};
491 my %base_class_roles;
492 %base_class_roles = ( roles => $args->{base_class_roles} )
493 if exists $args->{base_class_roles};
495 return unless %metaclass_roles || %base_class_roles;
501 return unless Class::MOP::class_of( $options{for_class} );
503 Moose::Util::MetaRole::apply_metaclass_roles(
504 for_class => $options{for_class},
508 Moose::Util::MetaRole::apply_base_class_roles(
509 for_class => $options{for_class},
512 if Class::MOP::class_of( $options{for_class} )
513 ->isa('Moose::Meta::Class');
515 return Class::MOP::class_of( $options{for_class} );
530 Moose::Exporter - make an import() and unimport() just like Moose.pm
534 package MyApp::Moose;
539 Moose::Exporter->setup_import_methods(
540 with_meta => [ 'has_rw', 'sugar2' ],
541 as_is => [ 'sugar3', \&Some::Random::thing ],
546 my ( $meta, $name, %options ) = @_;
547 $meta->add_attribute(
567 This module encapsulates the exporting of sugar functions in a
568 C<Moose.pm>-like manner. It does this by building custom C<import>,
569 C<unimport>, and C<init_meta> methods for your module, based on a spec you
572 It also lets you "stack" Moose-alike modules so you can export Moose's sugar
573 as well as your own, along with sugar from any random C<MooseX> module, as
574 long as they all use C<Moose::Exporter>. This feature exists to let you bundle
575 a set of MooseX modules into a policy module that developers can use directly
576 instead of using Moose itself.
578 To simplify writing exporter modules, C<Moose::Exporter> also imports
579 C<strict> and C<warnings> into your exporter module, as well as into
584 This module provides two public methods:
588 =item B<< Moose::Exporter->setup_import_methods(...) >>
590 When you call this method, C<Moose::Exporter> builds custom C<import>,
591 C<unimport>, and C<init_meta> methods for your module. The C<import> method
592 will export the functions you specify, and can also re-export functions
593 exported by some other module (like C<Moose.pm>).
595 The C<unimport> method cleans the caller's namespace of all the exported
598 If you pass any parameters for L<Moose::Util::MetaRole>, this method will
599 generate an C<init_meta> for you as well (see below for details). This
600 C<init_meta> will call C<Moose::Util::MetaRole::apply_metaclass_roles> and
601 C<Moose::Util::MetaRole::apply_base_class_roles> as needed.
603 Note that if any of these methods already exist, they will not be
604 overridden, you will have to use C<build_import_methods> to get the
605 coderef that would be installed.
607 This method accepts the following parameters:
611 =item * with_meta => [ ... ]
613 This list of function I<names only> will be wrapped and then exported. The
614 wrapper will pass the metaclass object for the caller as its first argument.
616 Many sugar functions will need to use this metaclass object to do something to
619 =item * as_is => [ ... ]
621 This list of function names or sub references will be exported as-is. You can
622 identify a subroutine by reference, which is handy to re-export some other
623 module's functions directly by reference (C<\&Some::Package::function>).
625 If you do export some other package's function, this function will never be
626 removed by the C<unimport> method. The reason for this is we cannot know if
627 the caller I<also> explicitly imported the sub themselves, and therefore wants
630 =item * also => $name or \@names
632 This is a list of modules which contain functions that the caller
633 wants to export. These modules must also use C<Moose::Exporter>. The
634 most common use case will be to export the functions from C<Moose.pm>.
635 Functions specified by C<with_meta> or C<as_is> take precedence over
636 functions exported by modules specified by C<also>, so that a module
637 can selectively override functions exported by another module.
639 C<Moose::Exporter> also makes sure all these functions get removed
640 when C<unimport> is called.
644 Any of the C<*_roles> options for
645 C<Moose::Util::MetaRole::apply_metaclass_roles> and
646 C<Moose::Util::MetaRole::base_class_roles> are also acceptable.
648 =item B<< Moose::Exporter->build_import_methods(...) >>
650 Returns two or three code refs, one for C<import>, one for
651 C<unimport>, and optionally one for C<init_meta>, if the appropriate
652 options are passed in.
654 Accepts the additional C<install> option, which accepts an arrayref of method
655 names to install into your exporting package. The valid options are C<import>,
656 C<unimport>, and C<init_meta>. Calling C<setup_import_methods> is equivalent
657 to calling C<build_import_methods> with C<< install => [qw(import unimport
658 init_meta)] >> except that it doesn't also return the methods.
660 Used by C<setup_import_methods>.
664 =head1 IMPORTING AND init_meta
666 If you want to set an alternative base object class or metaclass class, see
667 above for details on how this module can call L<Moose::Util::MetaRole> for
670 If you want to do something that is not supported by this module, simply
671 define an C<init_meta> method in your class. The C<import> method that
672 C<Moose::Exporter> generates for you will call this method (if it exists). It
673 will always pass the caller to this method via the C<for_class> parameter.
675 Most of the time, your C<init_meta> method will probably just call C<<
676 Moose->init_meta >> to do the real work:
679 shift; # our class name
680 return Moose->init_meta( @_, metaclass => 'My::Metaclass' );
683 Keep in mind that C<build_import_methods> will return an C<init_meta>
684 method for you, which you can also call from within your custom
687 my ( $import, $unimport, $init_meta ) =
688 Moose::Exporter->build_import_methods( ... );
695 $class->$import(...);
700 sub unimport { goto &$unimport }
707 $class->$init_meta(...);
712 =head1 METACLASS TRAITS
714 The C<import> method generated by C<Moose::Exporter> will allow the
715 user of your module to specify metaclass traits in a C<-traits>
716 parameter passed as part of the import:
718 use Moose -traits => 'My::Meta::Trait';
720 use Moose -traits => [ 'My::Meta::Trait', 'My::Other::Trait' ];
722 These traits will be applied to the caller's metaclass
723 instance. Providing traits for an exporting class that does not create
724 a metaclass for the caller is an error.
728 Dave Rolsky E<lt>autarch@urth.orgE<gt>
730 This is largely a reworking of code in Moose.pm originally written by
731 Stevan Little and others.
733 =head1 COPYRIGHT AND LICENSE
735 Copyright 2009 by Infinity Interactive, Inc.
737 L<http://www.iinteractive.com>
739 This library is free software; you can redistribute it and/or modify
740 it under the same terms as Perl itself.