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 if ( !defined(&$sub) ) {
137 "Trying to export undefined sub ${package}::${name}";
141 my $fq_name = $package . '::' . $name;
143 $exports{$name} = $class->_make_wrapped_sub_with_meta(
149 $is_removable{$name} = 1;
152 for my $name ( @{ $args->{with_caller} } ) {
155 \&{ $package . '::' . $name };
158 if ( !defined(&$sub) ) {
160 "Trying to export undefined sub ${package}::${name}";
164 my $fq_name = $package . '::' . $name;
166 $exports{$name} = $class->_make_wrapped_sub(
172 $is_removable{$name} = 1;
175 for my $name ( @{ $args->{as_is} } ) {
176 my ($sub, $coderef_name);
181 # Even though Moose re-exports things from Carp &
182 # Scalar::Util, we don't want to remove those at
183 # unimport time, because the importing package may
184 # have imported them explicitly ala
186 # use Carp qw( confess );
188 # This is a hack. Since we can't know whether they
189 # really want to keep these subs or not, we err on the
190 # safe side and leave them in.
192 ( $coderef_pkg, $coderef_name )
193 = Class::MOP::get_code_info($name);
195 $is_removable{$coderef_name} = $coderef_pkg eq $package ? 1 : 0;
200 \&{ $package . '::' . $name };
203 if ( !defined(&$sub) ) {
205 "Trying to export undefined sub ${package}::${name}";
209 $is_removable{$name} = 1;
210 $coderef_name = $name;
213 $export_recorder->{$sub} = 1;
215 $exports{$coderef_name} = sub {$sub};
219 return ( \%exports, \%is_removable );
224 sub _make_wrapped_sub {
228 my $export_recorder = shift;
230 # We need to set the package at import time, so that when
231 # package Foo imports has(), we capture "Foo" as the
232 # package. This lets other packages call Foo::has() and get
233 # the right package. This is done for backwards compatibility
234 # with existing production code, not because this is a good
237 my $caller = $CALLER;
239 my $wrapper = $self->_curry_wrapper($sub, $fq_name, $caller);
241 my $sub = subname($fq_name => $wrapper);
243 $export_recorder->{$sub} = 1;
249 sub _make_wrapped_sub_with_meta {
253 my $export_recorder = shift;
256 my $caller = $CALLER;
258 my $wrapper = $self->_late_curry_wrapper($sub, $fq_name,
259 sub { Class::MOP::class_of(shift) } => $caller);
261 my $sub = subname($fq_name => $wrapper);
263 $export_recorder->{$sub} = 1;
269 sub _make_wrapped_group {
271 my $package = shift; # package calling use Moose::Exporter
273 my $export_recorder = shift;
274 my $keywords = shift;
275 my $is_removable = shift;
278 my $caller = $CALLER; # package calling use PackageUsingMooseExporter -group => {args}
280 # there are plenty of ways to deal with telling the code which
281 # package it lives in. the last arg (collector hashref) is
282 # otherwise unused, so we'll stick the original package in
283 # there and act like 'with_caller' by putting the calling
284 # package name as the first arg
286 $_[3]{from} = $package;
288 my $named_code = $sub->(@_);
291 # send invalid return value error up to Sub::Exporter
292 unless (ref $named_code eq 'HASH') {
296 for my $name (keys %$named_code) {
297 my $code = $named_code->{$name};
299 my $fq_name = $package . '::' . $name;
300 my $wrapper = $class->_curry_wrapper(
306 my $sub = subname( $fq_name => $wrapper );
307 $named_code->{$name} = $sub;
309 # mark each coderef as ours
310 $keywords->{$name} = 1;
311 $is_removable->{$name} = 1;
312 $export_recorder->{$sub} = 1;
325 my $wrapper = sub { $sub->(@extra, @_) };
326 if (my $proto = prototype $sub) {
327 # XXX - Perl's prototype sucks. Use & to make set_prototype
328 # ignore the fact that we're passing "private variables"
329 &Scalar::Util::set_prototype($wrapper, $proto);
334 sub _late_curry_wrapper {
342 # resolve curried arguments at runtime via this closure
343 my @curry = ( $extra->( @ex_args ) );
344 return $sub->(@curry, @_);
347 if (my $proto = prototype $sub) {
348 # XXX - Perl's prototype sucks. Use & to make set_prototype
349 # ignore the fact that we're passing "private variables"
350 &Scalar::Util::set_prototype($wrapper, $proto);
355 sub _make_import_sub {
357 my $exporting_package = shift;
358 my $exporter = shift;
359 my $exports_from = shift;
360 my $export_to_main = shift;
364 # I think we could use Sub::Exporter's collector feature
365 # to do this, but that would be rather gross, since that
366 # feature isn't really designed to return a value to the
367 # caller of the exporter sub.
369 # Also, this makes sure we preserve backwards compat for
370 # _get_caller, so it always sees the arguments in the
373 ( $traits, @_ ) = _strip_traits(@_);
376 ( $metaclass, @_ ) = _strip_metaclass(@_);
377 $metaclass = Moose::Util::resolve_metaclass_alias(
378 'Class' => $metaclass
379 ) if defined $metaclass && length $metaclass;
381 # Normally we could look at $_[0], but in some weird cases
382 # (involving goto &Moose::import), $_[0] ends as something
383 # else (like Squirrel).
384 my $class = $exporting_package;
386 $CALLER = _get_caller(@_);
388 # this works because both pragmas set $^H (see perldoc
389 # perlvar) which affects the current compilation -
390 # i.e. the file who use'd us - which is why we don't need
391 # to do anything special to make it affect that file
392 # rather than this one (which is already compiled)
397 # we should never export to main
398 if ( $CALLER eq 'main' && !$export_to_main ) {
400 qq{$class does not export its sugar to the 'main' package.\n};
405 for my $c ( grep { $_->can('init_meta') } $class, @{$exports_from} ) {
406 # init_meta can apply a role, which when loaded uses
407 # Moose::Exporter, which in turn sets $CALLER, so we need
408 # to protect against that.
409 local $CALLER = $CALLER;
410 $c->init_meta( for_class => $CALLER, metaclass => $metaclass );
414 if ( $did_init_meta && @{$traits} ) {
415 # The traits will use Moose::Role, which in turn uses
416 # Moose::Exporter, which in turn sets $CALLER, so we need
417 # to protect against that.
418 local $CALLER = $CALLER;
419 _apply_meta_traits( $CALLER, $traits );
421 elsif ( @{$traits} ) {
424 "Cannot provide traits when $class does not have an init_meta() method"
434 my $idx = first_index { $_ eq '-traits' } @_;
436 return ( [], @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
438 my $traits = $_[ $idx + 1 ];
442 $traits = [ $traits ] unless ref $traits;
444 return ( $traits, @_ );
447 sub _strip_metaclass {
448 my $idx = first_index { $_ eq '-metaclass' } @_;
450 return ( undef, @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
452 my $metaclass = $_[ $idx + 1 ];
456 return ( $metaclass, @_ );
459 sub _apply_meta_traits {
460 my ( $class, $traits ) = @_;
462 return unless @{$traits};
464 my $meta = Class::MOP::class_of($class);
466 my $type = ( split /::/, ref $meta )[-1]
467 or Moose->throw_error(
468 'Cannot determine metaclass type for trait application . Meta isa '
473 ref $_ ? $_ : Moose::Util::resolve_metatrait_alias( $type => $_ )
477 return unless @resolved_traits;
479 Moose::Util::MetaRole::apply_metaclass_roles(
481 metaclass_roles => \@resolved_traits,
486 # 1 extra level because it's called by import so there's a layer
491 ( ref $_[1] && defined $_[1]->{into} ) ? $_[1]->{into}
492 : ( ref $_[1] && defined $_[1]->{into_level} )
493 ? caller( $offset + $_[1]->{into_level} )
497 sub _make_unimport_sub {
499 my $exporting_package = shift;
501 my $is_removable = shift;
502 my $export_recorder = shift;
505 my $caller = scalar caller();
506 Moose::Exporter->_remove_keywords(
508 [ keys %{$exports} ],
515 sub _remove_keywords {
518 my $keywords = shift;
519 my $is_removable = shift;
520 my $recorded_exports = shift;
524 foreach my $name ( @{ $keywords } ) {
525 next unless $is_removable->{$name};
527 if ( defined &{ $package . '::' . $name } ) {
528 my $sub = \&{ $package . '::' . $name };
530 # make sure it is from us
531 next unless $recorded_exports->{$sub};
533 # and if it is from us, then undef the slot
534 delete ${ $package . '::' }{$name};
539 sub _make_init_meta {
550 wrapped_method_metaclass
555 application_to_class_class
556 application_to_role_class
557 application_to_instance_class)
559 $metaclass_roles{$role} = $args->{$role} if exists $args->{$role};
562 my %base_class_roles;
563 %base_class_roles = ( roles => $args->{base_class_roles} )
564 if exists $args->{base_class_roles};
566 return unless %metaclass_roles || %base_class_roles;
572 return unless Class::MOP::class_of( $options{for_class} );
574 Moose::Util::MetaRole::apply_metaclass_roles(
575 for_class => $options{for_class},
579 Moose::Util::MetaRole::apply_base_class_roles(
580 for_class => $options{for_class},
583 if Class::MOP::class_of( $options{for_class} )
584 ->isa('Moose::Meta::Class');
586 return Class::MOP::class_of( $options{for_class} );
601 Moose::Exporter - make an import() and unimport() just like Moose.pm
605 package MyApp::Moose;
610 Moose::Exporter->setup_import_methods(
611 with_meta => [ 'has_rw', 'sugar2' ],
612 as_is => [ 'sugar3', \&Some::Random::thing ],
617 my ( $meta, $name, %options ) = @_;
618 $meta->add_attribute(
638 This module encapsulates the exporting of sugar functions in a
639 C<Moose.pm>-like manner. It does this by building custom C<import>,
640 C<unimport>, and C<init_meta> methods for your module, based on a spec you
643 It also lets you "stack" Moose-alike modules so you can export Moose's sugar
644 as well as your own, along with sugar from any random C<MooseX> module, as
645 long as they all use C<Moose::Exporter>. This feature exists to let you bundle
646 a set of MooseX modules into a policy module that developers can use directly
647 instead of using Moose itself.
649 To simplify writing exporter modules, C<Moose::Exporter> also imports
650 C<strict> and C<warnings> into your exporter module, as well as into
655 This module provides two public methods:
659 =item B<< Moose::Exporter->setup_import_methods(...) >>
661 When you call this method, C<Moose::Exporter> builds custom C<import>,
662 C<unimport>, and C<init_meta> methods for your module. The C<import> method
663 will export the functions you specify, and can also re-export functions
664 exported by some other module (like C<Moose.pm>).
666 The C<unimport> method cleans the caller's namespace of all the exported
669 If you pass any parameters for L<Moose::Util::MetaRole>, this method will
670 generate an C<init_meta> for you as well (see below for details). This
671 C<init_meta> will call C<Moose::Util::MetaRole::apply_metaclass_roles> and
672 C<Moose::Util::MetaRole::apply_base_class_roles> as needed.
674 Note that if any of these methods already exist, they will not be
675 overridden, you will have to use C<build_import_methods> to get the
676 coderef that would be installed.
678 This method accepts the following parameters:
682 =item * with_meta => [ ... ]
684 This list of function I<names only> will be wrapped and then exported. The
685 wrapper will pass the metaclass object for the caller as its first argument.
687 Many sugar functions will need to use this metaclass object to do something to
690 =item * as_is => [ ... ]
692 This list of function names or sub references will be exported as-is. You can
693 identify a subroutine by reference, which is handy to re-export some other
694 module's functions directly by reference (C<\&Some::Package::function>).
696 If you do export some other package's function, this function will never be
697 removed by the C<unimport> method. The reason for this is we cannot know if
698 the caller I<also> explicitly imported the sub themselves, and therefore wants
701 =item * also => $name or \@names
703 This is a list of modules which contain functions that the caller
704 wants to export. These modules must also use C<Moose::Exporter>. The
705 most common use case will be to export the functions from C<Moose.pm>.
706 Functions specified by C<with_meta> or C<as_is> take precedence over
707 functions exported by modules specified by C<also>, so that a module
708 can selectively override functions exported by another module.
710 C<Moose::Exporter> also makes sure all these functions get removed
711 when C<unimport> is called.
715 Any of the C<*_roles> options for
716 C<Moose::Util::MetaRole::apply_metaclass_roles> and
717 C<Moose::Util::MetaRole::base_class_roles> are also acceptable.
719 =item B<< Moose::Exporter->build_import_methods(...) >>
721 Returns two or three code refs, one for C<import>, one for
722 C<unimport>, and optionally one for C<init_meta>, if the appropriate
723 options are passed in.
725 Accepts the additional C<install> option, which accepts an arrayref of method
726 names to install into your exporting package. The valid options are C<import>,
727 C<unimport>, and C<init_meta>. Calling C<setup_import_methods> is equivalent
728 to calling C<build_import_methods> with C<< install => [qw(import unimport
729 init_meta)] >> except that it doesn't also return the methods.
731 Used by C<setup_import_methods>.
735 =head1 IMPORTING AND init_meta
737 If you want to set an alternative base object class or metaclass class, see
738 above for details on how this module can call L<Moose::Util::MetaRole> for
741 If you want to do something that is not supported by this module, simply
742 define an C<init_meta> method in your class. The C<import> method that
743 C<Moose::Exporter> generates for you will call this method (if it exists). It
744 will always pass the caller to this method via the C<for_class> parameter.
746 Most of the time, your C<init_meta> method will probably just call C<<
747 Moose->init_meta >> to do the real work:
750 shift; # our class name
751 return Moose->init_meta( @_, metaclass => 'My::Metaclass' );
754 Keep in mind that C<build_import_methods> will return an C<init_meta>
755 method for you, which you can also call from within your custom
758 my ( $import, $unimport, $init_meta ) =
759 Moose::Exporter->build_import_methods( ... );
766 $class->$import(...);
771 sub unimport { goto &$unimport }
778 $class->$init_meta(...);
783 =head1 METACLASS TRAITS
785 The C<import> method generated by C<Moose::Exporter> will allow the
786 user of your module to specify metaclass traits in a C<-traits>
787 parameter passed as part of the import:
789 use Moose -traits => 'My::Meta::Trait';
791 use Moose -traits => [ 'My::Meta::Trait', 'My::Other::Trait' ];
793 These traits will be applied to the caller's metaclass
794 instance. Providing traits for an exporting class that does not create
795 a metaclass for the caller is an error.
799 Dave Rolsky E<lt>autarch@urth.orgE<gt>
801 This is largely a reworking of code in Moose.pm originally written by
802 Stevan Little and others.
804 =head1 COPYRIGHT AND LICENSE
806 Copyright 2009 by Infinity Interactive, Inc.
808 L<http://www.iinteractive.com>
810 This library is free software; you can redistribute it and/or modify
811 it under the same terms as Perl itself.