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, $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 $methods{import} = $class->_make_import_sub( $exporting_package,
53 $exporter, \@exports_from );
55 $methods{unimport} = $class->_make_unimport_sub( $exporting_package,
56 $exports, $is_removable, $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;
122 for my $package ( @{$packages} ) {
123 my $args = $EXPORT_SPEC{$package}
124 or die "The $package package does not use Moose::Exporter\n";
126 for my $name ( @{ $args->{with_meta} } ) {
127 my $sub = $class->_sub_from_package( $package, $name )
130 my $fq_name = $package . '::' . $name;
132 $exports{$name} = $class->_make_wrapped_sub_with_meta(
138 $is_removable{$name} = 1;
141 for my $name ( @{ $args->{with_caller} } ) {
142 my $sub = $class->_sub_from_package( $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->{as_is} } ) {
157 my ($sub, $coderef_name);
162 # Even though Moose re-exports things from Carp &
163 # Scalar::Util, we don't want to remove those at
164 # unimport time, because the importing package may
165 # have imported them explicitly ala
167 # use Carp qw( confess );
169 # This is a hack. Since we can't know whether they
170 # really want to keep these subs or not, we err on the
171 # safe side and leave them in.
173 ( $coderef_pkg, $coderef_name )
174 = Class::MOP::get_code_info($name);
176 $is_removable{$coderef_name} = $coderef_pkg eq $package ? 1 : 0;
179 $sub = $class->_sub_from_package( $package, $name )
182 $is_removable{$name} = 1;
183 $coderef_name = $name;
186 $export_recorder->{$sub} = 1;
188 $exports{$coderef_name} = sub {$sub};
192 return ( \%exports, \%is_removable );
195 sub _sub_from_package {
202 \&{ $package . '::' . $name };
205 return $sub if defined &$sub;
208 "Trying to export undefined sub ${package}::${name}";
215 sub _make_wrapped_sub {
219 my $export_recorder = shift;
221 # We need to set the package at import time, so that when
222 # package Foo imports has(), we capture "Foo" as the
223 # package. This lets other packages call Foo::has() and get
224 # the right package. This is done for backwards compatibility
225 # with existing production code, not because this is a good
228 my $caller = $CALLER;
230 my $wrapper = $self->_curry_wrapper($sub, $fq_name, $caller);
232 my $sub = subname($fq_name => $wrapper);
234 $export_recorder->{$sub} = 1;
240 sub _make_wrapped_sub_with_meta {
244 my $export_recorder = shift;
247 my $caller = $CALLER;
249 my $wrapper = $self->_late_curry_wrapper($sub, $fq_name,
250 sub { Class::MOP::class_of(shift) } => $caller);
252 my $sub = subname($fq_name => $wrapper);
254 $export_recorder->{$sub} = 1;
266 my $wrapper = sub { $sub->(@extra, @_) };
267 if (my $proto = prototype $sub) {
268 # XXX - Perl's prototype sucks. Use & to make set_prototype
269 # ignore the fact that we're passing "private variables"
270 &Scalar::Util::set_prototype($wrapper, $proto);
275 sub _late_curry_wrapper {
283 # resolve curried arguments at runtime via this closure
284 my @curry = ( $extra->( @ex_args ) );
285 return $sub->(@curry, @_);
288 if (my $proto = prototype $sub) {
289 # XXX - Perl's prototype sucks. Use & to make set_prototype
290 # ignore the fact that we're passing "private variables"
291 &Scalar::Util::set_prototype($wrapper, $proto);
296 sub _make_import_sub {
298 my $exporting_package = shift;
299 my $exporter = shift;
300 my $exports_from = shift;
304 # I think we could use Sub::Exporter's collector feature
305 # to do this, but that would be rather gross, since that
306 # feature isn't really designed to return a value to the
307 # caller of the exporter sub.
309 # Also, this makes sure we preserve backwards compat for
310 # _get_caller, so it always sees the arguments in the
313 ( $traits, @_ ) = _strip_traits(@_);
316 ( $metaclass, @_ ) = _strip_metaclass(@_);
317 $metaclass = Moose::Util::resolve_metaclass_alias(
318 'Class' => $metaclass
319 ) if defined $metaclass && length $metaclass;
321 # Normally we could look at $_[0], but in some weird cases
322 # (involving goto &Moose::import), $_[0] ends as something
323 # else (like Squirrel).
324 my $class = $exporting_package;
326 $CALLER = _get_caller(@_);
328 # this works because both pragmas set $^H (see perldoc
329 # perlvar) which affects the current compilation -
330 # i.e. the file who use'd us - which is why we don't need
331 # to do anything special to make it affect that file
332 # rather than this one (which is already compiled)
338 for my $c ( grep { $_->can('init_meta') } $class, @{$exports_from} ) {
339 # init_meta can apply a role, which when loaded uses
340 # Moose::Exporter, which in turn sets $CALLER, so we need
341 # to protect against that.
342 local $CALLER = $CALLER;
343 $c->init_meta( for_class => $CALLER, metaclass => $metaclass );
347 if ( $did_init_meta && @{$traits} ) {
348 # The traits will use Moose::Role, which in turn uses
349 # Moose::Exporter, which in turn sets $CALLER, so we need
350 # to protect against that.
351 local $CALLER = $CALLER;
352 _apply_meta_traits( $CALLER, $traits );
354 elsif ( @{$traits} ) {
357 "Cannot provide traits when $class does not have an init_meta() method"
367 my $idx = first_index { $_ eq '-traits' } @_;
369 return ( [], @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
371 my $traits = $_[ $idx + 1 ];
375 $traits = [ $traits ] unless ref $traits;
377 return ( $traits, @_ );
380 sub _strip_metaclass {
381 my $idx = first_index { $_ eq '-metaclass' } @_;
383 return ( undef, @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
385 my $metaclass = $_[ $idx + 1 ];
389 return ( $metaclass, @_ );
392 sub _apply_meta_traits {
393 my ( $class, $traits ) = @_;
395 return unless @{$traits};
397 my $meta = Class::MOP::class_of($class);
399 my $type = ( split /::/, ref $meta )[-1]
400 or Moose->throw_error(
401 'Cannot determine metaclass type for trait application . Meta isa '
406 ref $_ ? $_ : Moose::Util::resolve_metatrait_alias( $type => $_ )
410 return unless @resolved_traits;
412 Moose::Util::MetaRole::apply_metaclass_roles(
414 metaclass_roles => \@resolved_traits,
419 # 1 extra level because it's called by import so there's a layer
424 ( ref $_[1] && defined $_[1]->{into} ) ? $_[1]->{into}
425 : ( ref $_[1] && defined $_[1]->{into_level} )
426 ? caller( $offset + $_[1]->{into_level} )
430 sub _make_unimport_sub {
432 my $exporting_package = shift;
434 my $is_removable = shift;
435 my $export_recorder = shift;
438 my $caller = scalar caller();
439 Moose::Exporter->_remove_keywords(
441 [ keys %{$exports} ],
448 sub _remove_keywords {
451 my $keywords = shift;
452 my $is_removable = shift;
453 my $recorded_exports = shift;
457 foreach my $name ( @{ $keywords } ) {
458 next unless $is_removable->{$name};
460 if ( defined &{ $package . '::' . $name } ) {
461 my $sub = \&{ $package . '::' . $name };
463 # make sure it is from us
464 next unless $recorded_exports->{$sub};
466 # and if it is from us, then undef the slot
467 delete ${ $package . '::' }{$name};
472 sub _make_init_meta {
483 wrapped_method_metaclass
488 application_to_class_class
489 application_to_role_class
490 application_to_instance_class)
492 $metaclass_roles{$role} = $args->{$role} if exists $args->{$role};
495 my %base_class_roles;
496 %base_class_roles = ( roles => $args->{base_class_roles} )
497 if exists $args->{base_class_roles};
499 return unless %metaclass_roles || %base_class_roles;
505 return unless Class::MOP::class_of( $options{for_class} );
507 Moose::Util::MetaRole::apply_metaclass_roles(
508 for_class => $options{for_class},
512 Moose::Util::MetaRole::apply_base_class_roles(
513 for_class => $options{for_class},
516 if Class::MOP::class_of( $options{for_class} )
517 ->isa('Moose::Meta::Class');
519 return Class::MOP::class_of( $options{for_class} );
534 Moose::Exporter - make an import() and unimport() just like Moose.pm
538 package MyApp::Moose;
543 Moose::Exporter->setup_import_methods(
544 with_meta => [ 'has_rw', 'sugar2' ],
545 as_is => [ 'sugar3', \&Some::Random::thing ],
550 my ( $meta, $name, %options ) = @_;
551 $meta->add_attribute(
571 This module encapsulates the exporting of sugar functions in a
572 C<Moose.pm>-like manner. It does this by building custom C<import>,
573 C<unimport>, and C<init_meta> methods for your module, based on a spec you
576 It also lets you "stack" Moose-alike modules so you can export Moose's sugar
577 as well as your own, along with sugar from any random C<MooseX> module, as
578 long as they all use C<Moose::Exporter>. This feature exists to let you bundle
579 a set of MooseX modules into a policy module that developers can use directly
580 instead of using Moose itself.
582 To simplify writing exporter modules, C<Moose::Exporter> also imports
583 C<strict> and C<warnings> into your exporter module, as well as into
588 This module provides two public methods:
592 =item B<< Moose::Exporter->setup_import_methods(...) >>
594 When you call this method, C<Moose::Exporter> builds custom C<import>,
595 C<unimport>, and C<init_meta> methods for your module. The C<import> method
596 will export the functions you specify, and can also re-export functions
597 exported by some other module (like C<Moose.pm>).
599 The C<unimport> method cleans the caller's namespace of all the exported
602 If you pass any parameters for L<Moose::Util::MetaRole>, this method will
603 generate an C<init_meta> for you as well (see below for details). This
604 C<init_meta> will call C<Moose::Util::MetaRole::apply_metaclass_roles> and
605 C<Moose::Util::MetaRole::apply_base_class_roles> as needed.
607 Note that if any of these methods already exist, they will not be
608 overridden, you will have to use C<build_import_methods> to get the
609 coderef that would be installed.
611 This method accepts the following parameters:
615 =item * with_meta => [ ... ]
617 This list of function I<names only> will be wrapped and then exported. The
618 wrapper will pass the metaclass object for the caller as its first argument.
620 Many sugar functions will need to use this metaclass object to do something to
623 =item * as_is => [ ... ]
625 This list of function names or sub references will be exported as-is. You can
626 identify a subroutine by reference, which is handy to re-export some other
627 module's functions directly by reference (C<\&Some::Package::function>).
629 If you do export some other package's function, this function will never be
630 removed by the C<unimport> method. The reason for this is we cannot know if
631 the caller I<also> explicitly imported the sub themselves, and therefore wants
634 =item * also => $name or \@names
636 This is a list of modules which contain functions that the caller
637 wants to export. These modules must also use C<Moose::Exporter>. The
638 most common use case will be to export the functions from C<Moose.pm>.
639 Functions specified by C<with_meta> or C<as_is> take precedence over
640 functions exported by modules specified by C<also>, so that a module
641 can selectively override functions exported by another module.
643 C<Moose::Exporter> also makes sure all these functions get removed
644 when C<unimport> is called.
648 Any of the C<*_roles> options for
649 C<Moose::Util::MetaRole::apply_metaclass_roles> and
650 C<Moose::Util::MetaRole::base_class_roles> are also acceptable.
652 =item B<< Moose::Exporter->build_import_methods(...) >>
654 Returns two or three code refs, one for C<import>, one for
655 C<unimport>, and optionally one for C<init_meta>, if the appropriate
656 options are passed in.
658 Accepts the additional C<install> option, which accepts an arrayref of method
659 names to install into your exporting package. The valid options are C<import>,
660 C<unimport>, and C<init_meta>. Calling C<setup_import_methods> is equivalent
661 to calling C<build_import_methods> with C<< install => [qw(import unimport
662 init_meta)] >> except that it doesn't also return the methods.
664 Used by C<setup_import_methods>.
668 =head1 IMPORTING AND init_meta
670 If you want to set an alternative base object class or metaclass class, see
671 above for details on how this module can call L<Moose::Util::MetaRole> for
674 If you want to do something that is not supported by this module, simply
675 define an C<init_meta> method in your class. The C<import> method that
676 C<Moose::Exporter> generates for you will call this method (if it exists). It
677 will always pass the caller to this method via the C<for_class> parameter.
679 Most of the time, your C<init_meta> method will probably just call C<<
680 Moose->init_meta >> to do the real work:
683 shift; # our class name
684 return Moose->init_meta( @_, metaclass => 'My::Metaclass' );
687 Keep in mind that C<build_import_methods> will return an C<init_meta>
688 method for you, which you can also call from within your custom
691 my ( $import, $unimport, $init_meta ) =
692 Moose::Exporter->build_import_methods( ... );
699 $class->$import(...);
704 sub unimport { goto &$unimport }
711 $class->$init_meta(...);
716 =head1 METACLASS TRAITS
718 The C<import> method generated by C<Moose::Exporter> will allow the
719 user of your module to specify metaclass traits in a C<-traits>
720 parameter passed as part of the import:
722 use Moose -traits => 'My::Meta::Trait';
724 use Moose -traits => [ 'My::Meta::Trait', 'My::Other::Trait' ];
726 These traits will be applied to the caller's metaclass
727 instance. Providing traits for an exporting class that does not create
728 a metaclass for the caller is an error.
732 Dave Rolsky E<lt>autarch@urth.orgE<gt>
734 This is largely a reworking of code in Moose.pm originally written by
735 Stevan Little and others.
737 =head1 COPYRIGHT AND LICENSE
739 Copyright 2009 by Infinity Interactive, Inc.
741 L<http://www.iinteractive.com>
743 This library is free software; you can redistribute it and/or modify
744 it under the same terms as Perl itself.