1 package Moose::Exporter;
6 use Carp qw( confess );
8 use List::MoreUtils qw( first_index uniq );
14 sub setup_import_methods {
15 my ( $class, %args ) = @_;
17 my $exporting_package = $args{exporting_package} ||= caller();
19 my ( $import, $unimport) = $class->build_import_methods( %args );
22 *{ $exporting_package . '::import' } = $import;
23 *{ $exporting_package . '::unimport' } = $unimport;
26 sub build_import_methods {
27 my ( $class, %args ) = @_;
29 my $exporting_package = $args{exporting_package} ||= caller();
31 $EXPORT_SPEC{$exporting_package} = \%args;
33 my @exports_from = $class->_follow_also( $exporting_package );
36 = $class->_make_sub_exporter_params( $exporting_package, @exports_from );
38 my $exporter = Sub::Exporter::build_exporter(
41 groups => { default => [':all'] }
45 # $args{_export_to_main} exists for backwards compat, because
46 # Moose::Util::TypeConstraints did export to main (unlike Moose &
48 my $import = $class->_make_import_sub( $exporter, \@exports_from, $args{_export_to_main} );
50 my $unimport = $class->_make_unimport_sub( \@exports_from, [ keys %{$exports} ] );
52 return ( $import, $unimport )
60 my $exporting_package = shift;
62 %seen = ( $exporting_package => 1 );
64 return uniq( _follow_also_real($exporting_package) );
67 sub _follow_also_real {
68 my $exporting_package = shift;
70 die "Package in also ($exporting_package) does not seem to use MooseX::Exporter"
71 unless exists $EXPORT_SPEC{$exporting_package};
73 my $also = $EXPORT_SPEC{$exporting_package}{also};
75 return unless defined $also;
77 my @also = ref $also ? @{$also} : $also;
79 for my $package (@also)
81 die "Circular reference in also parameter to MooseX::Exporter between $exporting_package and $package"
87 return @also, map { _follow_also_real($_) } @also;
91 sub _make_sub_exporter_params {
97 for my $package (@packages) {
98 my $args = $EXPORT_SPEC{$package}
99 or die "The $package package does not use Moose::Exporter\n";
101 for my $name ( @{ $args->{with_caller} } ) {
104 \&{ $package . '::' . $name };
107 $exports{$name} = $class->_make_wrapped_sub(
114 for my $name ( @{ $args->{as_is} } ) {
119 $name = ( Class::MOP::get_code_info($name) )[1];
124 \&{ $package . '::' . $name };
128 $exports{$name} = sub {$sub};
136 # This variable gets closed over in each export _generator_. Then
137 # in the generator we grab the value and close over it _again_ in
138 # the real export, so it gets captured each time the generator
141 # In the meantime, we arrange for the import method we generate to
142 # set this variable to the caller each time it is called.
144 # This is all a bit confusing, but it works.
147 sub _make_wrapped_sub {
149 my $exporting_package = shift;
153 # We need to set the package at import time, so that when
154 # package Foo imports has(), we capture "Foo" as the
155 # package. This lets other packages call Foo::has() and get
156 # the right package. This is done for backwards compatibility
157 # with existing production code, not because this is a good
160 my $caller = $CALLER;
161 Class::MOP::subname( $exporting_package . '::'
162 . $name => sub { $sub->( $caller, @_ ) } );
166 sub _make_import_sub {
168 my $exporter = shift;
169 my $exports_from = shift;
170 my $export_to_main = shift;
173 # I think we could use Sub::Exporter's collector feature
174 # to do this, but that would be rather gross, since that
175 # feature isn't really designed to return a value to the
176 # caller of the exporter sub.
178 # Also, this makes sure we preserve backwards compat for
179 # _get_caller, so it always sees the arguments in the
182 ($traits, @_) = Moose::Exporter::_strip_traits(@_);
184 # It's important to leave @_ as-is for the benefit of
188 $CALLER = Moose::Exporter::_get_caller(@_);
190 # this works because both pragmas set $^H (see perldoc
191 # perlvar) which affects the current compilation -
192 # i.e. the file who use'd us - which is why we don't need
193 # to do anything special to make it affect that file
194 # rather than this one (which is already compiled)
199 # we should never export to main
200 if ( $CALLER eq 'main' && ! $export_to_main ) {
202 qq{$class does not export its sugar to the 'main' package.\n};
207 for my $c ( grep { $_->can('init_meta') } $class, @{$exports_from} ) {
209 $c->init_meta( for_class => $CALLER );
213 if ($did_init_meta) {
214 _apply_meta_traits( $CALLER, $traits );
216 elsif ( $traits && @{$traits} ) {
218 "Cannot provide traits when $class does not have an init_meta() method";
227 my $idx = first_index { $_ eq '-traits' } @_;
229 return ( undef, @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
231 my $traits = $_[ $idx + 1 ];
235 $traits = [ $traits ] unless ref $traits;
237 return ( $traits, @_ );
240 sub _apply_meta_traits {
241 my ( $class, $traits ) = @_;
244 unless $traits && @$traits;
246 my $meta = $class->meta();
248 my $type = ( split /::/, ref $meta )[-1]
250 'Cannot determine metaclass type for trait application . Meta isa '
253 # We can only call does_role() on Moose::Meta::Class objects, and
254 # we can only do that on $meta->meta() if it has already had at
255 # least one trait applied to it. By default $meta->meta() returns
256 # a Class::MOP::Class object (not a Moose::Meta::Class).
258 $meta->meta()->can('does_role')
259 ? not $meta->meta()->does_role($_)
262 map { Moose::Util::resolve_metatrait_alias( $type => $_ ) } @$traits;
264 return unless @traits;
266 Moose::Util::apply_all_roles_with_method( $meta,
267 'apply_to_metaclass_instance', \@traits );
271 # 1 extra level because it's called by import so there's a layer
276 ( ref $_[1] && defined $_[1]->{into} ) ? $_[1]->{into}
277 : ( ref $_[1] && defined $_[1]->{into_level} )
278 ? caller( $offset + $_[1]->{into_level} )
282 sub _make_unimport_sub {
285 my $keywords = shift;
289 my $caller = scalar caller();
290 Moose::Exporter->_remove_keywords(
292 [ $class, @{$sources} ],
298 sub _remove_keywords {
302 my $keywords = shift;
304 my %sources = map { $_ => 1 } @{$sources};
308 # loop through the keywords ...
309 foreach my $name ( @{$keywords} ) {
312 if ( defined &{ $package . '::' . $name } ) {
313 my $keyword = \&{ $package . '::' . $name };
315 # make sure it is from us
316 my ($pkg_name) = Class::MOP::get_code_info($keyword);
317 next unless $sources{$pkg_name};
319 # and if it is from us, then undef the slot
320 delete ${ $package . '::' }{$name};
331 Moose::Exporter - make an import() and unimport() just like Moose.pm
335 package MyApp::Moose;
343 Moose::Exporter->setup_import_methods(
344 export => [ 'sugar1', 'sugar2', \&Some::Random::thing ],
345 init_meta_args => { metaclass_class => 'MyApp::Meta::Class' ],
354 sugar1 'do your thing';
361 This module encapsulates the logic to export sugar functions like
362 C<Moose.pm>. It does this by building custom C<import> and C<unimport>
363 methods for your module, based on a spec your provide.
365 It also lets your "stack" Moose-alike modules so you can export
366 Moose's sugar as well as your own, along with sugar from any random
367 C<MooseX> module, as long as they all use C<Moose::Exporter>.
371 This module provides exactly one public method:
373 =head2 Moose::Exporter->setup_import_methods(...)
375 When you call this method, C<Moose::Exporter> build custom C<import>
376 and C<unimport> methods for your module. The import method will export
377 the functions you specify, and you can also tell it to export
378 functions exported by some other module (like C<Moose.pm>).
380 The C<unimport> method cleans the callers namespace of all the
383 This method accepts the following parameters:
387 =item * with_caller => [ ... ]
389 This a list of function I<names only> to be exported wrapped and then
390 exported. The wrapper will pass the name of the calling package as the
391 first argument to the function. Many sugar functions need to know
392 their caller so they can get the calling package's metaclass object.
394 =item * as_is => [ ... ]
396 This a list of function names or sub references to be exported
397 as-is. You can identify a subroutine by reference, which is handy to
398 re-export some other module's functions directly by reference
399 (C<\&Some::Package::function>).
401 =item * also => $name or \@names
403 This is a list of modules which contain functions that the caller
404 wants to export. These modules must also use C<Moose::Exporter>. The
405 most common use case will be to export the functions from C<Moose.pm>.
407 C<Moose::Exporter> also makes sure all these functions get removed
408 when C<unimport> is called.
412 =head2 Moose::Exporter->build_import_methods(...)
414 Returns two code refs, one for import and one for unimport.
416 Used by C<setup_import_methods>.
418 =head1 IMPORTING AND init_meta
420 If you want to set an alternative base object class or metaclass
421 class, simply define an C<init_meta> method in your class. The
422 C<import> method that C<Moose::Exporter> generates for you will call
423 this method (if it exists). It will always pass the caller to this
424 method via the C<for_class> parameter.
426 Most of the time, your C<init_meta> method will probably just call C<<
427 Moose->init_meta >> to do the real work:
430 shift; # our class name
431 return Moose->init_meta( @_, metaclass => 'My::Metaclass' );
434 =head1 METACLASS TRAITS
436 The C<import> method generated by C<Moose::Exporter> will allow the
437 user of your module to specify metaclass traits in a C<-traits>
438 parameter passed as part of the import:
440 use Moose -traits => 'My::Meta::Trait';
442 use Moose -traits => [ 'My::Meta::Trait', 'My::Other::Trait' ];
444 These traits will be applied to the caller's metaclass
445 instance. Providing traits for an exporting class that does not create
446 a metaclass for the caller is an error.
450 Dave Rolsky E<lt>autarch@urth.orgE<gt>
452 This is largely a reworking of code in Moose.pm originally written by
453 Stevan Little and others.
455 =head1 COPYRIGHT AND LICENSE
457 Copyright 2008 by Infinity Interactive, Inc.
459 L<http://www.iinteractive.com>
461 This library is free software; you can redistribute it and/or modify
462 it under the same terms as Perl itself.