1 package Moose::Exporter;
6 our $VERSION = '0.93_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 XSLoader::load( 'Moose', $VERSION );
22 sub setup_import_methods {
23 my ( $class, %args ) = @_;
25 my $exporting_package = $args{exporting_package} ||= caller();
27 $class->build_import_methods(
29 install => [qw(import unimport init_meta)]
33 sub build_import_methods {
34 my ( $class, %args ) = @_;
36 my $exporting_package = $args{exporting_package} ||= caller();
38 $EXPORT_SPEC{$exporting_package} = \%args;
40 my @exports_from = $class->_follow_also($exporting_package);
42 my $export_recorder = {};
45 my $exports = $class->_make_sub_exporter_params(
46 [ @exports_from, $exporting_package ],
51 my $exporter = Sub::Exporter::build_exporter(
54 groups => { default => [':all'] }
59 $methods{import} = $class->_make_import_sub(
66 $methods{unimport} = $class->_make_unimport_sub(
73 $methods{init_meta} = $class->_make_init_meta(
78 my $package = Class::MOP::Package->initialize($exporting_package);
79 for my $to_install ( @{ $args{install} || [] } ) {
80 my $symbol = '&' . $to_install;
82 unless $methods{$to_install}
83 && !$package->has_package_symbol($symbol);
84 $package->add_package_symbol( $symbol, $methods{$to_install} );
87 return ( $methods{import}, $methods{unimport}, $methods{init_meta} );
95 my $exporting_package = shift;
97 local %$seen = ( $exporting_package => 1 );
99 return uniq( _follow_also_real($exporting_package) );
102 sub _follow_also_real {
103 my $exporting_package = shift;
105 if ( !exists $EXPORT_SPEC{$exporting_package} ) {
106 my $loaded = Class::MOP::is_class_loaded($exporting_package);
108 die "Package in also ($exporting_package) does not seem to "
109 . "use Moose::Exporter"
110 . ( $loaded ? "" : " (is it loaded?)" );
113 my $also = $EXPORT_SPEC{$exporting_package}{also};
115 return unless defined $also;
117 my @also = ref $also ? @{$also} : $also;
119 for my $package (@also) {
121 "Circular reference in 'also' parameter to Moose::Exporter between $exporting_package and $package"
122 if $seen->{$package};
124 $seen->{$package} = 1;
127 return @also, map { _follow_also_real($_) } @also;
131 sub _make_sub_exporter_params {
133 my $packages = shift;
134 my $export_recorder = shift;
135 my $is_reexport = shift;
139 for my $package ( @{$packages} ) {
140 my $args = $EXPORT_SPEC{$package}
141 or die "The $package package does not use Moose::Exporter\n";
143 for my $name ( @{ $args->{with_meta} } ) {
144 my $sub = $class->_sub_from_package( $package, $name )
147 my $fq_name = $package . '::' . $name;
149 $exports{$name} = $class->_make_wrapped_sub_with_meta(
156 for my $name ( @{ $args->{with_caller} } ) {
157 my $sub = $class->_sub_from_package( $package, $name )
160 my $fq_name = $package . '::' . $name;
162 $exports{$name} = $class->_make_wrapped_sub(
169 for my $name ( @{ $args->{as_is} } ) {
170 my ( $sub, $coderef_name );
176 ( $coderef_pkg, $coderef_name )
177 = Class::MOP::get_code_info($name);
179 if ( $coderef_pkg ne $package ) {
180 $is_reexport->{$coderef_name} = 1;
184 $sub = $class->_sub_from_package( $package, $name )
187 $coderef_name = $name;
190 $export_recorder->{$sub} = 1;
192 $exports{$coderef_name} = sub {$sub};
199 sub _sub_from_package {
206 \&{ $package . '::' . $name };
209 return $sub if defined &$sub;
211 Carp::cluck "Trying to export undefined sub ${package}::${name}";
218 sub _make_wrapped_sub {
222 my $export_recorder = shift;
224 # We need to set the package at import time, so that when
225 # package Foo imports has(), we capture "Foo" as the
226 # package. This lets other packages call Foo::has() and get
227 # the right package. This is done for backwards compatibility
228 # with existing production code, not because this is a good
231 my $caller = $CALLER;
233 my $wrapper = $self->_curry_wrapper( $sub, $fq_name, $caller );
235 my $sub = subname( $fq_name => $wrapper );
237 $export_recorder->{$sub} = 1;
243 sub _make_wrapped_sub_with_meta {
247 my $export_recorder = shift;
250 my $caller = $CALLER;
252 my $wrapper = $self->_late_curry_wrapper(
254 sub { Class::MOP::class_of(shift) } => $caller
257 my $sub = subname( $fq_name => $wrapper );
259 $export_recorder->{$sub} = 1;
271 my $wrapper = sub { $sub->( @extra, @_ ) };
272 if ( my $proto = prototype $sub ) {
274 # XXX - Perl's prototype sucks. Use & to make set_prototype
275 # ignore the fact that we're passing "private variables"
276 &Scalar::Util::set_prototype( $wrapper, $proto );
281 sub _late_curry_wrapper {
290 # resolve curried arguments at runtime via this closure
291 my @curry = ( $extra->(@ex_args) );
292 return $sub->( @curry, @_ );
295 if ( my $proto = prototype $sub ) {
297 # XXX - Perl's prototype sucks. Use & to make set_prototype
298 # ignore the fact that we're passing "private variables"
299 &Scalar::Util::set_prototype( $wrapper, $proto );
304 sub _make_import_sub {
306 my $exporting_package = shift;
307 my $exporter = shift;
308 my $exports_from = shift;
309 my $is_reexport = shift;
313 # I think we could use Sub::Exporter's collector feature
314 # to do this, but that would be rather gross, since that
315 # feature isn't really designed to return a value to the
316 # caller of the exporter sub.
318 # Also, this makes sure we preserve backwards compat for
319 # _get_caller, so it always sees the arguments in the
322 ( $traits, @_ ) = _strip_traits(@_);
325 ( $metaclass, @_ ) = _strip_metaclass(@_);
327 = Moose::Util::resolve_metaclass_alias( 'Class' => $metaclass )
328 if defined $metaclass && length $metaclass;
330 # Normally we could look at $_[0], but in some weird cases
331 # (involving goto &Moose::import), $_[0] ends as something
332 # else (like Squirrel).
333 my $class = $exporting_package;
335 $CALLER = _get_caller(@_);
337 # this works because both pragmas set $^H (see perldoc
338 # perlvar) which affects the current compilation -
339 # i.e. the file who use'd us - which is why we don't need
340 # to do anything special to make it affect that file
341 # rather than this one (which is already compiled)
347 for my $c ( grep { $_->can('init_meta') } $class, @{$exports_from} ) {
349 # init_meta can apply a role, which when loaded uses
350 # Moose::Exporter, which in turn sets $CALLER, so we need
351 # to protect against that.
352 local $CALLER = $CALLER;
353 $c->init_meta( for_class => $CALLER, metaclass => $metaclass );
357 if ( $did_init_meta && @{$traits} ) {
359 # The traits will use Moose::Role, which in turn uses
360 # Moose::Exporter, which in turn sets $CALLER, so we need
361 # to protect against that.
362 local $CALLER = $CALLER;
363 _apply_meta_traits( $CALLER, $traits );
365 elsif ( @{$traits} ) {
368 "Cannot provide traits when $class does not have an init_meta() method"
372 my ( undef, @args ) = @_;
373 my $extra = shift @args if ref $args[0] eq 'HASH';
376 if ( !$extra->{into} ) {
377 $extra->{into_level} ||= 0;
378 $extra->{into_level}++;
381 $class->$exporter( $extra, @args );
383 for my $name ( keys %{$is_reexport} ) {
386 _flag_as_reexport( \*{ join q{::}, $CALLER, $name } );
392 my $idx = first_index { $_ eq '-traits' } @_;
394 return ( [], @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
396 my $traits = $_[ $idx + 1 ];
400 $traits = [$traits] unless ref $traits;
402 return ( $traits, @_ );
405 sub _strip_metaclass {
406 my $idx = first_index { $_ eq '-metaclass' } @_;
408 return ( undef, @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
410 my $metaclass = $_[ $idx + 1 ];
414 return ( $metaclass, @_ );
417 sub _apply_meta_traits {
418 my ( $class, $traits ) = @_;
420 return unless @{$traits};
422 my $meta = Class::MOP::class_of($class);
424 my $type = ( split /::/, ref $meta )[-1]
425 or Moose->throw_error(
426 'Cannot determine metaclass type for trait application . Meta isa '
429 my @resolved_traits = map {
432 : Moose::Util::resolve_metatrait_alias( $type => $_ )
435 return unless @resolved_traits;
437 my %args = ( for => $class );
439 if ( $meta->isa('Moose::Meta::Role') ) {
440 $args{role_metaroles} = { role => \@resolved_traits };
443 $args{class_metaroles} = { class => \@resolved_traits };
446 Moose::Util::MetaRole::apply_metaroles(%args);
451 # 1 extra level because it's called by import so there's a layer
456 ( ref $_[1] && defined $_[1]->{into} ) ? $_[1]->{into}
457 : ( ref $_[1] && defined $_[1]->{into_level} )
458 ? caller( $offset + $_[1]->{into_level} )
462 sub _make_unimport_sub {
464 my $exporting_package = shift;
466 my $export_recorder = shift;
467 my $is_reexport = shift;
470 my $caller = scalar caller();
471 Moose::Exporter->_remove_keywords(
473 [ keys %{$exports} ],
480 sub _remove_keywords {
483 my $keywords = shift;
484 my $recorded_exports = shift;
485 my $is_reexport = shift;
489 foreach my $name ( @{$keywords} ) {
490 if ( defined &{ $package . '::' . $name } ) {
491 my $sub = \&{ $package . '::' . $name };
493 # make sure it is from us
494 next unless $recorded_exports->{$sub};
496 if ( $is_reexport->{$name} ) {
499 unless _export_is_flagged(
500 \*{ join q{::} => $package, $name } );
503 # and if it is from us, then undef the slot
504 delete ${ $package . '::' }{$name};
509 sub _make_init_meta {
521 wrapped_method_metaclass
528 $old_style_roles{$role} = $args->{$role}
529 if exists $args->{$role};
532 my %base_class_roles;
533 %base_class_roles = ( roles => $args->{base_class_roles} )
534 if exists $args->{base_class_roles};
536 my %new_style_roles = map { $_ => $args->{$_} }
537 grep { exists $args->{$_} } qw( class_metaroles role_metaroles );
539 return unless %new_style_roles || %old_style_roles || %base_class_roles;
545 return unless Class::MOP::class_of( $options{for_class} );
547 Moose::Util::MetaRole::apply_metaroles(
548 for => $options{for_class},
553 Moose::Util::MetaRole::apply_base_class_roles(
554 for_class => $options{for_class},
557 if Class::MOP::class_of( $options{for_class} )
558 ->isa('Moose::Meta::Class');
560 return Class::MOP::class_of( $options{for_class} );
575 Moose::Exporter - make an import() and unimport() just like Moose.pm
579 package MyApp::Moose;
584 Moose::Exporter->setup_import_methods(
585 with_meta => [ 'has_rw', 'sugar2' ],
586 as_is => [ 'sugar3', \&Some::Random::thing ],
591 my ( $meta, $name, %options ) = @_;
592 $meta->add_attribute(
612 This module encapsulates the exporting of sugar functions in a
613 C<Moose.pm>-like manner. It does this by building custom C<import>,
614 C<unimport>, and C<init_meta> methods for your module, based on a spec you
617 It also lets you "stack" Moose-alike modules so you can export Moose's sugar
618 as well as your own, along with sugar from any random C<MooseX> module, as
619 long as they all use C<Moose::Exporter>. This feature exists to let you bundle
620 a set of MooseX modules into a policy module that developers can use directly
621 instead of using Moose itself.
623 To simplify writing exporter modules, C<Moose::Exporter> also imports
624 C<strict> and C<warnings> into your exporter module, as well as into
629 This module provides two public methods:
633 =item B<< Moose::Exporter->setup_import_methods(...) >>
635 When you call this method, C<Moose::Exporter> builds custom C<import>,
636 C<unimport>, and C<init_meta> methods for your module. The C<import> method
637 will export the functions you specify, and can also re-export functions
638 exported by some other module (like C<Moose.pm>).
640 The C<unimport> method cleans the caller's namespace of all the exported
641 functions. This includes any functions you re-export from other
642 packages. However, if the consumer of your package also imports those
643 functions from the original package, they will I<not> be cleaned.
645 If you pass any parameters for L<Moose::Util::MetaRole>, this method will
646 generate an C<init_meta> for you as well (see below for details). This
647 C<init_meta> will call C<Moose::Util::MetaRole::apply_metaclass_roles> and
648 C<Moose::Util::MetaRole::apply_base_class_roles> as needed.
650 Note that if any of these methods already exist, they will not be
651 overridden, you will have to use C<build_import_methods> to get the
652 coderef that would be installed.
654 This method accepts the following parameters:
658 =item * with_meta => [ ... ]
660 This list of function I<names only> will be wrapped and then exported. The
661 wrapper will pass the metaclass object for the caller as its first argument.
663 Many sugar functions will need to use this metaclass object to do something to
666 =item * as_is => [ ... ]
668 This list of function names or sub references will be exported as-is. You can
669 identify a subroutine by reference, which is handy to re-export some other
670 module's functions directly by reference (C<\&Some::Package::function>).
672 If you do export some other package's function, this function will never be
673 removed by the C<unimport> method. The reason for this is we cannot know if
674 the caller I<also> explicitly imported the sub themselves, and therefore wants
677 =item * also => $name or \@names
679 This is a list of modules which contain functions that the caller
680 wants to export. These modules must also use C<Moose::Exporter>. The
681 most common use case will be to export the functions from C<Moose.pm>.
682 Functions specified by C<with_meta> or C<as_is> take precedence over
683 functions exported by modules specified by C<also>, so that a module
684 can selectively override functions exported by another module.
686 C<Moose::Exporter> also makes sure all these functions get removed
687 when C<unimport> is called.
691 You can also provide parameters for C<Moose::Util::MetaRole::apply_metaroles>
692 and C<Moose::Util::MetaRole::base_class_roles>. Specifically, valid parameters
693 are "class_metaroles", "role_metaroles", and "base_object_roles".
695 =item B<< Moose::Exporter->build_import_methods(...) >>
697 Returns two or three code refs, one for C<import>, one for
698 C<unimport>, and optionally one for C<init_meta>, if the appropriate
699 options are passed in.
701 Accepts the additional C<install> option, which accepts an arrayref of method
702 names to install into your exporting package. The valid options are C<import>,
703 C<unimport>, and C<init_meta>. Calling C<setup_import_methods> is equivalent
704 to calling C<build_import_methods> with C<< install => [qw(import unimport
705 init_meta)] >> except that it doesn't also return the methods.
707 Used by C<setup_import_methods>.
711 =head1 IMPORTING AND init_meta
713 If you want to set an alternative base object class or metaclass class, see
714 above for details on how this module can call L<Moose::Util::MetaRole> for
717 If you want to do something that is not supported by this module, simply
718 define an C<init_meta> method in your class. The C<import> method that
719 C<Moose::Exporter> generates for you will call this method (if it exists). It
720 will always pass the caller to this method via the C<for_class> parameter.
722 Most of the time, your C<init_meta> method will probably just call C<<
723 Moose->init_meta >> to do the real work:
726 shift; # our class name
727 return Moose->init_meta( @_, metaclass => 'My::Metaclass' );
730 Keep in mind that C<build_import_methods> will return an C<init_meta>
731 method for you, which you can also call from within your custom
734 my ( $import, $unimport, $init_meta ) =
735 Moose::Exporter->build_import_methods( ... );
742 $class->$import(...);
747 sub unimport { goto &$unimport }
754 $class->$init_meta(...);
759 =head1 METACLASS TRAITS
761 The C<import> method generated by C<Moose::Exporter> will allow the
762 user of your module to specify metaclass traits in a C<-traits>
763 parameter passed as part of the import:
765 use Moose -traits => 'My::Meta::Trait';
767 use Moose -traits => [ 'My::Meta::Trait', 'My::Other::Trait' ];
769 These traits will be applied to the caller's metaclass
770 instance. Providing traits for an exporting class that does not create
771 a metaclass for the caller is an error.
775 See L<Moose/BUGS> for details on reporting bugs.
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.