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 )
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} } ) {
132 \&{ $package . '::' . $name };
135 my $fq_name = $package . '::' . $name;
137 $exports{$name} = $class->_make_wrapped_sub_with_meta(
143 $is_removable{$name} = 1;
146 for my $name ( @{ $args->{with_caller} } ) {
149 \&{ $package . '::' . $name };
152 my $fq_name = $package . '::' . $name;
154 $exports{$name} = $class->_make_wrapped_sub(
160 $is_removable{$name} = 1;
163 for my $name ( @{ $args->{as_is} } ) {
169 # Even though Moose re-exports things from Carp &
170 # Scalar::Util, we don't want to remove those at
171 # unimport time, because the importing package may
172 # have imported them explicitly ala
174 # use Carp qw( confess );
176 # This is a hack. Since we can't know whether they
177 # really want to keep these subs or not, we err on the
178 # safe side and leave them in.
180 ( $coderef_pkg, $name ) = Class::MOP::get_code_info($name);
182 $is_removable{$name} = $coderef_pkg eq $package ? 1 : 0;
187 \&{ $package . '::' . $name };
190 $is_removable{$name} = 1;
193 $export_recorder->{$sub} = 1;
195 $exports{$name} = sub {$sub};
199 return ( \%exports, \%is_removable );
204 sub _make_wrapped_sub {
208 my $export_recorder = shift;
210 # We need to set the package at import time, so that when
211 # package Foo imports has(), we capture "Foo" as the
212 # package. This lets other packages call Foo::has() and get
213 # the right package. This is done for backwards compatibility
214 # with existing production code, not because this is a good
217 my $caller = $CALLER;
219 my $wrapper = $self->_curry_wrapper($sub, $fq_name, $caller);
221 my $sub = subname($fq_name => $wrapper);
223 $export_recorder->{$sub} = 1;
229 sub _make_wrapped_sub_with_meta {
233 my $export_recorder = shift;
236 my $caller = $CALLER;
238 my $wrapper = $self->_late_curry_wrapper($sub, $fq_name,
239 sub { Class::MOP::class_of(shift) } => $caller);
241 my $sub = subname($fq_name => $wrapper);
243 $export_recorder->{$sub} = 1;
249 sub _make_wrapped_group {
251 my $package = shift; # package calling use Moose::Exporter
253 my $export_recorder = shift;
254 my $keywords = shift;
255 my $is_removable = shift;
258 my $caller = $CALLER; # package calling use PackageUsingMooseExporter -group => {args}
260 # there are plenty of ways to deal with telling the code which
261 # package it lives in. the last arg (collector hashref) is
262 # otherwise unused, so we'll stick the original package in
263 # there and act like 'with_caller' by putting the calling
264 # package name as the first arg
266 $_[3]{from} = $package;
268 my $named_code = $sub->(@_);
271 # send invalid return value error up to Sub::Exporter
272 unless (ref $named_code eq 'HASH') {
276 for my $name (keys %$named_code) {
277 my $code = $named_code->{$name};
279 my $fq_name = $package . '::' . $name;
280 my $wrapper = $class->_curry_wrapper(
286 my $sub = subname( $fq_name => $wrapper );
287 $named_code->{$name} = $sub;
289 # mark each coderef as ours
290 $keywords->{$name} = 1;
291 $is_removable->{$name} = 1;
292 $export_recorder->{$sub} = 1;
305 my $wrapper = sub { $sub->(@extra, @_) };
306 if (my $proto = prototype $sub) {
307 # XXX - Perl's prototype sucks. Use & to make set_prototype
308 # ignore the fact that we're passing "private variables"
309 &Scalar::Util::set_prototype($wrapper, $proto);
314 sub _late_curry_wrapper {
322 # resolve curried arguments at runtime via this closure
323 my @curry = ( $extra->( @ex_args ) );
324 return $sub->(@curry, @_);
327 if (my $proto = prototype $sub) {
328 # XXX - Perl's prototype sucks. Use & to make set_prototype
329 # ignore the fact that we're passing "private variables"
330 &Scalar::Util::set_prototype($wrapper, $proto);
335 sub _make_import_sub {
337 my $exporting_package = shift;
338 my $exporter = shift;
339 my $exports_from = shift;
340 my $export_to_main = shift;
344 # I think we could use Sub::Exporter's collector feature
345 # to do this, but that would be rather gross, since that
346 # feature isn't really designed to return a value to the
347 # caller of the exporter sub.
349 # Also, this makes sure we preserve backwards compat for
350 # _get_caller, so it always sees the arguments in the
353 ( $traits, @_ ) = _strip_traits(@_);
356 ( $metaclass, @_ ) = _strip_metaclass(@_);
357 $metaclass = Moose::Util::resolve_metaclass_alias(
358 'Class' => $metaclass
359 ) if defined $metaclass && length $metaclass;
361 # Normally we could look at $_[0], but in some weird cases
362 # (involving goto &Moose::import), $_[0] ends as something
363 # else (like Squirrel).
364 my $class = $exporting_package;
366 $CALLER = _get_caller(@_);
368 # this works because both pragmas set $^H (see perldoc
369 # perlvar) which affects the current compilation -
370 # i.e. the file who use'd us - which is why we don't need
371 # to do anything special to make it affect that file
372 # rather than this one (which is already compiled)
377 # we should never export to main
378 if ( $CALLER eq 'main' && !$export_to_main ) {
380 qq{$class does not export its sugar to the 'main' package.\n};
385 for my $c ( grep { $_->can('init_meta') } $class, @{$exports_from} ) {
386 # init_meta can apply a role, which when loaded uses
387 # Moose::Exporter, which in turn sets $CALLER, so we need
388 # to protect against that.
389 local $CALLER = $CALLER;
390 $c->init_meta( for_class => $CALLER, metaclass => $metaclass );
394 if ( $did_init_meta && @{$traits} ) {
395 # The traits will use Moose::Role, which in turn uses
396 # Moose::Exporter, which in turn sets $CALLER, so we need
397 # to protect against that.
398 local $CALLER = $CALLER;
399 _apply_meta_traits( $CALLER, $traits );
401 elsif ( @{$traits} ) {
404 "Cannot provide traits when $class does not have an init_meta() method"
414 my $idx = first_index { $_ eq '-traits' } @_;
416 return ( [], @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
418 my $traits = $_[ $idx + 1 ];
422 $traits = [ $traits ] unless ref $traits;
424 return ( $traits, @_ );
427 sub _strip_metaclass {
428 my $idx = first_index { $_ eq '-metaclass' } @_;
430 return ( undef, @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
432 my $metaclass = $_[ $idx + 1 ];
436 return ( $metaclass, @_ );
439 sub _apply_meta_traits {
440 my ( $class, $traits ) = @_;
442 return unless @{$traits};
444 my $meta = Class::MOP::class_of($class);
446 my $type = ( split /::/, ref $meta )[-1]
447 or Moose->throw_error(
448 'Cannot determine metaclass type for trait application . Meta isa '
453 ref $_ ? $_ : Moose::Util::resolve_metatrait_alias( $type => $_ )
457 return unless @resolved_traits;
459 Moose::Util::MetaRole::apply_metaclass_roles(
461 metaclass_roles => \@resolved_traits,
466 # 1 extra level because it's called by import so there's a layer
471 ( ref $_[1] && defined $_[1]->{into} ) ? $_[1]->{into}
472 : ( ref $_[1] && defined $_[1]->{into_level} )
473 ? caller( $offset + $_[1]->{into_level} )
477 sub _make_unimport_sub {
479 my $exporting_package = shift;
481 my $is_removable = shift;
482 my $export_recorder = shift;
485 my $caller = scalar caller();
486 Moose::Exporter->_remove_keywords(
488 [ keys %{$exports} ],
495 sub _remove_keywords {
498 my $keywords = shift;
499 my $is_removable = shift;
500 my $recorded_exports = shift;
504 foreach my $name ( @{ $keywords } ) {
505 next unless $is_removable->{$name};
507 if ( defined &{ $package . '::' . $name } ) {
508 my $sub = \&{ $package . '::' . $name };
510 # make sure it is from us
511 next unless $recorded_exports->{$sub};
513 # and if it is from us, then undef the slot
514 delete ${ $package . '::' }{$name};
519 sub _make_init_meta {
530 wrapped_method_metaclass
535 application_to_class_class
536 application_to_role_class
537 application_to_instance_class)
539 $metaclass_roles{$role} = $args->{$role} if exists $args->{$role};
542 my %base_class_roles;
543 %base_class_roles = ( roles => $args->{base_class_roles} )
544 if exists $args->{base_class_roles};
546 return unless %metaclass_roles || %base_class_roles;
552 return unless Class::MOP::class_of( $options{for_class} );
554 Moose::Util::MetaRole::apply_metaclass_roles(
555 for_class => $options{for_class},
559 Moose::Util::MetaRole::apply_base_class_roles(
560 for_class => $options{for_class},
563 if Class::MOP::class_of( $options{for_class} )
564 ->isa('Moose::Meta::Class');
566 return Class::MOP::class_of( $options{for_class} );
581 Moose::Exporter - make an import() and unimport() just like Moose.pm
585 package MyApp::Moose;
590 Moose::Exporter->setup_import_methods(
591 with_meta => [ 'has_rw', 'sugar2' ],
592 as_is => [ 'sugar3', \&Some::Random::thing ],
597 my ( $meta, $name, %options ) = @_;
598 $meta->add_attribute(
618 This module encapsulates the exporting of sugar functions in a
619 C<Moose.pm>-like manner. It does this by building custom C<import>,
620 C<unimport>, and C<init_meta> methods for your module, based on a spec you
623 It also lets you "stack" Moose-alike modules so you can export Moose's sugar
624 as well as your own, along with sugar from any random C<MooseX> module, as
625 long as they all use C<Moose::Exporter>. This feature exists to let you bundle
626 a set of MooseX modules into a policy module that developers can use directly
627 instead of using Moose itself.
629 To simplify writing exporter modules, C<Moose::Exporter> also imports
630 C<strict> and C<warnings> into your exporter module, as well as into
635 This module provides two public methods:
639 =item B<< Moose::Exporter->setup_import_methods(...) >>
641 When you call this method, C<Moose::Exporter> builds custom C<import>,
642 C<unimport>, and C<init_meta> methods for your module. The C<import> method
643 will export the functions you specify, and can also re-export functions
644 exported by some other module (like C<Moose.pm>).
646 The C<unimport> method cleans the caller's namespace of all the exported
649 If you pass any parameters for L<Moose::Util::MetaRole>, this method will
650 generate an C<init_meta> for you as well (see below for details). This
651 C<init_meta> will call C<Moose::Util::MetaRole::apply_metaclass_roles> and
652 C<Moose::Util::MetaRole::apply_base_class_roles> as needed.
654 Note that if any of these methods already exist, they will not be
655 overridden, you will have to use C<build_import_methods> to get the
656 coderef that would be installed.
658 This method accepts the following parameters:
662 =item * with_meta => [ ... ]
664 This list of function I<names only> will be wrapped and then exported. The
665 wrapper will pass the metaclass object for the caller as its first argument.
667 Many sugar functions will need to use this metaclass object to do something to
670 =item * as_is => [ ... ]
672 This list of function names or sub references will be exported as-is. You can
673 identify a subroutine by reference, which is handy to re-export some other
674 module's functions directly by reference (C<\&Some::Package::function>).
676 If you do export some other package's function, this function will never be
677 removed by the C<unimport> method. The reason for this is we cannot know if
678 the caller I<also> explicitly imported the sub themselves, and therefore wants
681 =item * also => $name or \@names
683 This is a list of modules which contain functions that the caller
684 wants to export. These modules must also use C<Moose::Exporter>. The
685 most common use case will be to export the functions from C<Moose.pm>.
686 Functions specified by C<with_meta> or C<as_is> take precedence over
687 functions exported by modules specified by C<also>, so that a module
688 can selectively override functions exported by another module.
690 C<Moose::Exporter> also makes sure all these functions get removed
691 when C<unimport> is called.
695 Any of the C<*_roles> options for
696 C<Moose::Util::MetaRole::apply_metaclass_roles> and
697 C<Moose::Util::MetaRole::base_class_roles> are also acceptable.
699 =item B<< Moose::Exporter->build_import_methods(...) >>
701 Returns two or three code refs, one for C<import>, one for
702 C<unimport>, and optionally one for C<init_meta>, if the appropriate
703 options are passed in.
705 Accepts the additional C<install> option, which accepts an arrayref of method
706 names to install into your exporting package. The valid options are C<import>,
707 C<unimport>, and C<init_meta>. Calling C<setup_import_methods> is equivalent
708 to calling C<build_import_methods> with C<< install => [qw(import unimport
709 init_meta)] >> except that it doesn't also return the methods.
711 Used by C<setup_import_methods>.
715 =head1 IMPORTING AND init_meta
717 If you want to set an alternative base object class or metaclass class, see
718 above for details on how this module can call L<Moose::Util::MetaRole> for
721 If you want to do something that is not supported by this module, simply
722 define an C<init_meta> method in your class. The C<import> method that
723 C<Moose::Exporter> generates for you will call this method (if it exists). It
724 will always pass the caller to this method via the C<for_class> parameter.
726 Most of the time, your C<init_meta> method will probably just call C<<
727 Moose->init_meta >> to do the real work:
730 shift; # our class name
731 return Moose->init_meta( @_, metaclass => 'My::Metaclass' );
734 Keep in mind that C<build_import_methods> will return an C<init_meta>
735 method for you, which you can also call from within your custom
738 my ( $import, $unimport, $init_meta ) =
739 Moose::Exporter->build_import_methods( ... );
746 $class->$import(...);
751 sub unimport { goto &$unimport }
758 $class->$init_meta(...);
763 =head1 METACLASS TRAITS
765 The C<import> method generated by C<Moose::Exporter> will allow the
766 user of your module to specify metaclass traits in a C<-traits>
767 parameter passed as part of the import:
769 use Moose -traits => 'My::Meta::Trait';
771 use Moose -traits => [ 'My::Meta::Trait', 'My::Other::Trait' ];
773 These traits will be applied to the caller's metaclass
774 instance. Providing traits for an exporting class that does not create
775 a metaclass for the caller is an error.
779 Dave Rolsky E<lt>autarch@urth.orgE<gt>
781 This is largely a reworking of code in Moose.pm originally written by
782 Stevan Little and others.
784 =head1 COPYRIGHT AND LICENSE
786 Copyright 2009 by Infinity Interactive, Inc.
788 L<http://www.iinteractive.com>
790 This library is free software; you can redistribute it and/or modify
791 it under the same terms as Perl itself.