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 my $fq_name = $package . '::' . $name;
147 $exports{$name} = $class->_make_wrapped_sub(
153 $is_removable{$name} = 1;
156 for my $name ( @{ $args->{with_meta} } ) {
159 \&{ $package . '::' . $name };
162 my $fq_name = $package . '::' . $name;
164 $exports{$name} = $class->_make_wrapped_sub_with_meta(
170 $is_removable{$name} = 1;
173 for my $name ( @{ $args->{as_is} } ) {
179 # Even though Moose re-exports things from Carp &
180 # Scalar::Util, we don't want to remove those at
181 # unimport time, because the importing package may
182 # have imported them explicitly ala
184 # use Carp qw( confess );
186 # This is a hack. Since we can't know whether they
187 # really want to keep these subs or not, we err on the
188 # safe side and leave them in.
190 ( $coderef_pkg, $name ) = Class::MOP::get_code_info($name);
192 $is_removable{$name} = $coderef_pkg eq $package ? 1 : 0;
197 \&{ $package . '::' . $name };
200 $is_removable{$name} = 1;
203 $export_recorder->{$sub} = 1;
205 $exports{$name} = sub {$sub};
208 for my $name ( keys %{ $args->{groups} } ) {
209 my $group = $args->{groups}{$name};
211 if (ref $group eq 'CODE') {
212 $groups{$name} = $class->_make_wrapped_group(
220 elsif (ref $group eq 'ARRAY') {
221 $groups{$name} = $group;
226 return ( \%exports, \%is_removable, \%groups );
231 sub _make_wrapped_sub {
235 my $export_recorder = shift;
237 # We need to set the package at import time, so that when
238 # package Foo imports has(), we capture "Foo" as the
239 # package. This lets other packages call Foo::has() and get
240 # the right package. This is done for backwards compatibility
241 # with existing production code, not because this is a good
244 my $caller = $CALLER;
246 my $wrapper = $self->_curry_wrapper($sub, $fq_name, $caller);
248 my $sub = subname($fq_name => $wrapper);
250 $export_recorder->{$sub} = 1;
256 sub _make_wrapped_sub_with_meta {
260 my $export_recorder = shift;
263 my $caller = $CALLER;
265 my $wrapper = $self->_late_curry_wrapper($sub, $fq_name,
266 sub { Class::MOP::class_of(shift) } => $caller);
268 my $sub = subname($fq_name => $wrapper);
270 $export_recorder->{$sub} = 1;
276 sub _make_wrapped_group {
278 my $package = shift; # package calling use Moose::Exporter
280 my $export_recorder = shift;
281 my $keywords = shift;
282 my $is_removable = shift;
285 my $caller = $CALLER; # package calling use PackageUsingMooseExporter -group => {args}
287 # there are plenty of ways to deal with telling the code which
288 # package it lives in. the last arg (collector hashref) is
289 # otherwise unused, so we'll stick the original package in
290 # there and act like 'with_caller' by putting the calling
291 # package name as the first arg
293 $_[3]{from} = $package;
295 my $named_code = $sub->(@_);
298 # send invalid return value error up to Sub::Exporter
299 unless (ref $named_code eq 'HASH') {
303 for my $name (keys %$named_code) {
304 my $code = $named_code->{$name};
306 my $fq_name = $package . '::' . $name;
307 my $wrapper = $class->_curry_wrapper(
313 my $sub = subname( $fq_name => $wrapper );
314 $named_code->{$name} = $sub;
316 # mark each coderef as ours
317 $keywords->{$name} = 1;
318 $is_removable->{$name} = 1;
319 $export_recorder->{$sub} = 1;
332 my $wrapper = sub { $sub->(@extra, @_) };
333 if (my $proto = prototype $sub) {
334 # XXX - Perl's prototype sucks. Use & to make set_prototype
335 # ignore the fact that we're passing "private variables"
336 &Scalar::Util::set_prototype($wrapper, $proto);
341 sub _late_curry_wrapper {
349 # resolve curried arguments at runtime via this closure
350 my @curry = ( $extra->( @ex_args ) );
351 return $sub->(@curry, @_);
354 if (my $proto = prototype $sub) {
355 # XXX - Perl's prototype sucks. Use & to make set_prototype
356 # ignore the fact that we're passing "private variables"
357 &Scalar::Util::set_prototype($wrapper, $proto);
362 sub _make_import_sub {
364 my $exporting_package = shift;
365 my $exporter = shift;
366 my $exports_from = shift;
367 my $export_to_main = shift;
371 # I think we could use Sub::Exporter's collector feature
372 # to do this, but that would be rather gross, since that
373 # feature isn't really designed to return a value to the
374 # caller of the exporter sub.
376 # Also, this makes sure we preserve backwards compat for
377 # _get_caller, so it always sees the arguments in the
380 ( $traits, @_ ) = _strip_traits(@_);
383 ( $metaclass, @_ ) = _strip_metaclass(@_);
384 $metaclass = Moose::Util::resolve_metaclass_alias(
385 'Class' => $metaclass
386 ) if defined $metaclass && length $metaclass;
388 # Normally we could look at $_[0], but in some weird cases
389 # (involving goto &Moose::import), $_[0] ends as something
390 # else (like Squirrel).
391 my $class = $exporting_package;
393 $CALLER = _get_caller(@_);
395 # this works because both pragmas set $^H (see perldoc
396 # perlvar) which affects the current compilation -
397 # i.e. the file who use'd us - which is why we don't need
398 # to do anything special to make it affect that file
399 # rather than this one (which is already compiled)
404 # we should never export to main
405 if ( $CALLER eq 'main' && !$export_to_main ) {
407 qq{$class does not export its sugar to the 'main' package.\n};
412 for my $c ( grep { $_->can('init_meta') } $class, @{$exports_from} ) {
413 # init_meta can apply a role, which when loaded uses
414 # Moose::Exporter, which in turn sets $CALLER, so we need
415 # to protect against that.
416 local $CALLER = $CALLER;
417 $c->init_meta( for_class => $CALLER, metaclass => $metaclass );
421 if ( $did_init_meta && @{$traits} ) {
422 # The traits will use Moose::Role, which in turn uses
423 # Moose::Exporter, which in turn sets $CALLER, so we need
424 # to protect against that.
425 local $CALLER = $CALLER;
426 _apply_meta_traits( $CALLER, $traits );
428 elsif ( @{$traits} ) {
431 "Cannot provide traits when $class does not have an init_meta() method"
441 my $idx = first_index { $_ eq '-traits' } @_;
443 return ( [], @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
445 my $traits = $_[ $idx + 1 ];
449 $traits = [ $traits ] unless ref $traits;
451 return ( $traits, @_ );
454 sub _strip_metaclass {
455 my $idx = first_index { $_ eq '-metaclass' } @_;
457 return ( undef, @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
459 my $metaclass = $_[ $idx + 1 ];
463 return ( $metaclass, @_ );
466 sub _apply_meta_traits {
467 my ( $class, $traits ) = @_;
469 return unless @{$traits};
471 my $meta = Class::MOP::class_of($class);
473 my $type = ( split /::/, ref $meta )[-1]
474 or Moose->throw_error(
475 'Cannot determine metaclass type for trait application . Meta isa '
480 ref $_ ? $_ : Moose::Util::resolve_metatrait_alias( $type => $_ )
484 return unless @resolved_traits;
486 Moose::Util::MetaRole::apply_metaclass_roles(
488 metaclass_roles => \@resolved_traits,
493 # 1 extra level because it's called by import so there's a layer
498 ( ref $_[1] && defined $_[1]->{into} ) ? $_[1]->{into}
499 : ( ref $_[1] && defined $_[1]->{into_level} )
500 ? caller( $offset + $_[1]->{into_level} )
504 sub _make_unimport_sub {
506 my $exporting_package = shift;
508 my $is_removable = shift;
509 my $export_recorder = shift;
512 my $caller = scalar caller();
513 Moose::Exporter->_remove_keywords(
515 [ keys %{$exports} ],
522 sub _remove_keywords {
525 my $keywords = shift;
526 my $is_removable = shift;
527 my $recorded_exports = shift;
531 foreach my $name ( @{ $keywords } ) {
532 next unless $is_removable->{$name};
534 if ( defined &{ $package . '::' . $name } ) {
535 my $sub = \&{ $package . '::' . $name };
537 # make sure it is from us
538 next unless $recorded_exports->{$sub};
540 # and if it is from us, then undef the slot
541 delete ${ $package . '::' }{$name};
546 sub _make_init_meta {
557 wrapped_method_metaclass
562 application_to_class_class
563 application_to_role_class
564 application_to_instance_class)
566 $metaclass_roles{$role} = $args->{$role} if exists $args->{$role};
569 my %base_class_roles;
570 %base_class_roles = ( roles => $args->{base_class_roles} )
571 if exists $args->{base_class_roles};
573 return unless %metaclass_roles || %base_class_roles;
579 return unless Class::MOP::class_of( $options{for_class} );
581 Moose::Util::MetaRole::apply_metaclass_roles(
582 for_class => $options{for_class},
586 Moose::Util::MetaRole::apply_base_class_roles(
587 for_class => $options{for_class},
590 if Class::MOP::class_of( $options{for_class} )
591 ->isa('Moose::Meta::Class');
593 return Class::MOP::class_of( $options{for_class} );
608 Moose::Exporter - make an import() and unimport() just like Moose.pm
612 package MyApp::Moose;
617 Moose::Exporter->setup_import_methods(
618 with_caller => [ 'has_rw', 'sugar2' ],
619 as_is => [ 'sugar3', \&Some::Random::thing ],
624 my ($caller, $name, %options) = @_;
625 Class::MOP::class_of($caller)->add_attribute($name,
644 This module encapsulates the exporting of sugar functions in a
645 C<Moose.pm>-like manner. It does this by building custom C<import>,
646 C<unimport>, and C<init_meta> methods for your module, based on a spec you
649 It also lets you "stack" Moose-alike modules so you can export Moose's sugar
650 as well as your own, along with sugar from any random C<MooseX> module, as
651 long as they all use C<Moose::Exporter>. This feature exists to let you bundle
652 a set of MooseX modules into a policy module that developers can use directly
653 instead of using Moose itself.
655 To simplify writing exporter modules, C<Moose::Exporter> also imports
656 C<strict> and C<warnings> into your exporter module, as well as into
661 This module provides two public methods:
665 =item B<< Moose::Exporter->setup_import_methods(...) >>
667 When you call this method, C<Moose::Exporter> builds custom C<import>,
668 C<unimport>, and C<init_meta> methods for your module. The C<import> method
669 will export the functions you specify, and can also re-export functions
670 exported by some other module (like C<Moose.pm>).
672 The C<unimport> method cleans the caller's namespace of all the exported
675 If you pass any parameters for L<Moose::Util::MetaRole>, this method will
676 generate an C<init_meta> for you as well (see below for details). This
677 C<init_meta> will call C<Moose::Util::MetaRole::apply_metaclass_roles> and
678 C<Moose::Util::MetaRole::apply_base_class_roles> as needed.
680 Note that if any of these methods already exist, they will not be
681 overridden, you will have to use C<build_import_methods> to get the
682 coderef that would be installed.
684 This method accepts the following parameters:
688 =item * with_caller => [ ... ]
690 This list of function I<names only> will be wrapped and then exported. The
691 wrapper will pass the name of the calling package as the first argument to the
692 function. Many sugar functions need to know their caller so they can get the
693 calling package's metaclass object.
695 =item * as_is => [ ... ]
697 This list of function names or sub references will be exported as-is. You can
698 identify a subroutine by reference, which is handy to re-export some other
699 module's functions directly by reference (C<\&Some::Package::function>).
701 If you do export some other package's function, this function will never be
702 removed by the C<unimport> method. The reason for this is we cannot know if
703 the caller I<also> explicitly imported the sub themselves, and therefore wants
706 =item * also => $name or \@names
708 This is a list of modules which contain functions that the caller
709 wants to export. These modules must also use C<Moose::Exporter>. The
710 most common use case will be to export the functions from C<Moose.pm>.
711 Functions specified by C<with_caller> or C<as_is> take precedence over
712 functions exported by modules specified by C<also>, so that a module
713 can selectively override functions exported by another module.
715 C<Moose::Exporter> also makes sure all these functions get removed
716 when C<unimport> is called.
720 Any of the C<*_roles> options for
721 C<Moose::Util::MetaRole::apply_metaclass_roles> and
722 C<Moose::Util::MetaRole::base_class_roles> are also acceptable.
724 =item B<< Moose::Exporter->build_import_methods(...) >>
726 Returns two or three code refs, one for C<import>, one for
727 C<unimport>, and optionally one for C<init_meta>, if the appropriate
728 options are passed in.
730 Accepts the additional C<install> option, which accepts an arrayref of method
731 names to install into your exporting package. The valid options are C<import>,
732 C<unimport>, and C<init_meta>. Calling C<setup_import_methods> is equivalent
733 to calling C<build_import_methods> with C<< install => [qw(import unimport
734 init_meta)] >> except that it doesn't also return the methods.
736 Used by C<setup_import_methods>.
740 =head1 IMPORTING AND init_meta
742 If you want to set an alternative base object class or metaclass class, see
743 above for details on how this module can call L<Moose::Util::MetaRole> for
746 If you want to do something that is not supported by this module, simply
747 define an C<init_meta> method in your class. The C<import> method that
748 C<Moose::Exporter> generates for you will call this method (if it exists). It
749 will always pass the caller to this method via the C<for_class> parameter.
751 Most of the time, your C<init_meta> method will probably just call C<<
752 Moose->init_meta >> to do the real work:
755 shift; # our class name
756 return Moose->init_meta( @_, metaclass => 'My::Metaclass' );
759 Keep in mind that C<build_import_methods> will return an C<init_meta>
760 method for you, which you can also call from within your custom
763 my ( $import, $unimport, $init_meta ) =
764 Moose::Exporter->build_import_methods( ... );
771 $class->$import(...);
776 sub unimport { goto &$unimport }
783 $class->$init_meta(...);
788 =head1 METACLASS TRAITS
790 The C<import> method generated by C<Moose::Exporter> will allow the
791 user of your module to specify metaclass traits in a C<-traits>
792 parameter passed as part of the import:
794 use Moose -traits => 'My::Meta::Trait';
796 use Moose -traits => [ 'My::Meta::Trait', 'My::Other::Trait' ];
798 These traits will be applied to the caller's metaclass
799 instance. Providing traits for an exporting class that does not create
800 a metaclass for the caller is an error.
804 Dave Rolsky E<lt>autarch@urth.orgE<gt>
806 This is largely a reworking of code in Moose.pm originally written by
807 Stevan Little and others.
809 =head1 COPYRIGHT AND LICENSE
811 Copyright 2009 by Infinity Interactive, Inc.
813 L<http://www.iinteractive.com>
815 This library is free software; you can redistribute it and/or modify
816 it under the same terms as Perl itself.