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( $exporting_package, $exporter,
49 \@exports_from, $args{_export_to_main} );
52 = $class->_make_unimport_sub( $exporting_package, \@exports_from,
53 [ keys %{$exports} ] );
55 return ( $import, $unimport )
63 my $exporting_package = shift;
65 local %$seen = ( $exporting_package => 1 );
67 return uniq( _follow_also_real($exporting_package) );
70 sub _follow_also_real {
71 my $exporting_package = shift;
73 die "Package in also ($exporting_package) does not seem to use MooseX::Exporter"
74 unless exists $EXPORT_SPEC{$exporting_package};
76 my $also = $EXPORT_SPEC{$exporting_package}{also};
78 return unless defined $also;
80 my @also = ref $also ? @{$also} : $also;
82 for my $package (@also)
84 die "Circular reference in also parameter to MooseX::Exporter between $exporting_package and $package"
87 $seen->{$package} = 1;
90 return @also, map { _follow_also_real($_) } @also;
94 sub _make_sub_exporter_params {
100 for my $package (@packages) {
101 my $args = $EXPORT_SPEC{$package}
102 or die "The $package package does not use Moose::Exporter\n";
104 for my $name ( @{ $args->{with_caller} } ) {
107 \&{ $package . '::' . $name };
110 $exports{$name} = $class->_make_wrapped_sub(
117 for my $name ( @{ $args->{as_is} } ) {
122 $name = ( Class::MOP::get_code_info($name) )[1];
127 \&{ $package . '::' . $name };
131 $exports{$name} = sub {$sub};
139 # This variable gets closed over in each export _generator_. Then
140 # in the generator we grab the value and close over it _again_ in
141 # the real export, so it gets captured each time the generator
144 # In the meantime, we arrange for the import method we generate to
145 # set this variable to the caller each time it is called.
147 # This is all a bit confusing, but it works.
150 sub _make_wrapped_sub {
152 my $exporting_package = shift;
156 # We need to set the package at import time, so that when
157 # package Foo imports has(), we capture "Foo" as the
158 # package. This lets other packages call Foo::has() and get
159 # the right package. This is done for backwards compatibility
160 # with existing production code, not because this is a good
163 my $caller = $CALLER;
164 Class::MOP::subname( $exporting_package . '::'
165 . $name => sub { $sub->( $caller, @_ ) } );
169 sub _make_import_sub {
171 my $exporting_package = shift;
172 my $exporter = shift;
173 my $exports_from = shift;
174 my $export_to_main = shift;
177 # I think we could use Sub::Exporter's collector feature
178 # to do this, but that would be rather gross, since that
179 # feature isn't really designed to return a value to the
180 # caller of the exporter sub.
182 # Also, this makes sure we preserve backwards compat for
183 # _get_caller, so it always sees the arguments in the
186 ($traits, @_) = Moose::Exporter::_strip_traits(@_);
188 # Normally we could look at $_[0], but in some weird cases
189 # (involving goto &Moose::import), $_[0] ends as something
190 # else (like Squirrel).
191 my $class = $exporting_package;
193 $CALLER = Moose::Exporter::_get_caller(@_);
195 # this works because both pragmas set $^H (see perldoc
196 # perlvar) which affects the current compilation -
197 # i.e. the file who use'd us - which is why we don't need
198 # to do anything special to make it affect that file
199 # rather than this one (which is already compiled)
204 # we should never export to main
205 if ( $CALLER eq 'main' && ! $export_to_main ) {
207 qq{$class does not export its sugar to the 'main' package.\n};
212 for my $c ( grep { $_->can('init_meta') } $class, @{$exports_from} ) {
214 $c->init_meta( for_class => $CALLER );
218 if ($did_init_meta) {
219 _apply_meta_traits( $CALLER, $traits );
221 elsif ( $traits && @{$traits} ) {
223 "Cannot provide traits when $class does not have an init_meta() method";
232 my $idx = first_index { $_ eq '-traits' } @_;
234 return ( undef, @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
236 my $traits = $_[ $idx + 1 ];
240 $traits = [ $traits ] unless ref $traits;
242 return ( $traits, @_ );
245 sub _apply_meta_traits {
246 my ( $class, $traits ) = @_;
249 unless $traits && @$traits;
251 my $meta = $class->meta();
253 my $type = ( split /::/, ref $meta )[-1]
255 'Cannot determine metaclass type for trait application . Meta isa '
258 # We can only call does_role() on Moose::Meta::Class objects, and
259 # we can only do that on $meta->meta() if it has already had at
260 # least one trait applied to it. By default $meta->meta() returns
261 # a Class::MOP::Class object (not a Moose::Meta::Class).
263 $meta->meta()->can('does_role')
264 ? not $meta->meta()->does_role($_)
267 map { Moose::Util::resolve_metatrait_alias( $type => $_ ) } @$traits;
269 return unless @traits;
271 Moose::Util::apply_all_roles_with_method( $meta,
272 'apply_to_metaclass_instance', \@traits );
276 # 1 extra level because it's called by import so there's a layer
281 ( ref $_[1] && defined $_[1]->{into} ) ? $_[1]->{into}
282 : ( ref $_[1] && defined $_[1]->{into_level} )
283 ? caller( $offset + $_[1]->{into_level} )
287 sub _make_unimport_sub {
289 my $exporting_package = shift;
291 my $keywords = shift;
294 my $caller = scalar caller();
295 Moose::Exporter->_remove_keywords(
297 [ $exporting_package, @{$sources} ],
303 sub _remove_keywords {
307 my $keywords = shift;
309 my %sources = map { $_ => 1 } @{$sources};
313 # loop through the keywords ...
314 foreach my $name ( @{$keywords} ) {
317 if ( defined &{ $package . '::' . $name } ) {
318 my $keyword = \&{ $package . '::' . $name };
320 # make sure it is from us
321 my ($pkg_name) = Class::MOP::get_code_info($keyword);
322 next unless $sources{$pkg_name};
324 # and if it is from us, then undef the slot
325 delete ${ $package . '::' }{$name};
336 Moose::Exporter - make an import() and unimport() just like Moose.pm
340 package MyApp::Moose;
348 Moose::Exporter->setup_import_methods(
349 with_caller => [ 'sugar1', 'sugar2' ],
350 as_is => [ 'sugar3', \&Some::Random::thing ],
360 sugar1 'do your thing';
367 This module encapsulates the logic to export sugar functions like
368 C<Moose.pm>. It does this by building custom C<import> and C<unimport>
369 methods for your module, based on a spec your provide.
371 It also lets your "stack" Moose-alike modules so you can export
372 Moose's sugar as well as your own, along with sugar from any random
373 C<MooseX> module, as long as they all use C<Moose::Exporter>.
377 This module provides two public methods:
379 =head2 Moose::Exporter->setup_import_methods(...)
381 When you call this method, C<Moose::Exporter> build custom C<import>
382 and C<unimport> methods for your module. The import method will export
383 the functions you specify, and you can also tell it to export
384 functions exported by some other module (like C<Moose.pm>).
386 The C<unimport> method cleans the callers namespace of all the
389 This method accepts the following parameters:
393 =item * with_caller => [ ... ]
395 This a list of function I<names only> to be exported wrapped and then
396 exported. The wrapper will pass the name of the calling package as the
397 first argument to the function. Many sugar functions need to know
398 their caller so they can get the calling package's metaclass object.
400 =item * as_is => [ ... ]
402 This a list of function names or sub references to be exported
403 as-is. You can identify a subroutine by reference, which is handy to
404 re-export some other module's functions directly by reference
405 (C<\&Some::Package::function>).
407 =item * also => $name or \@names
409 This is a list of modules which contain functions that the caller
410 wants to export. These modules must also use C<Moose::Exporter>. The
411 most common use case will be to export the functions from C<Moose.pm>.
413 C<Moose::Exporter> also makes sure all these functions get removed
414 when C<unimport> is called.
418 =head2 Moose::Exporter->build_import_methods(...)
420 Returns two code refs, one for import and one for unimport.
422 Used by C<setup_import_methods>.
424 =head1 IMPORTING AND init_meta
426 If you want to set an alternative base object class or metaclass
427 class, simply define an C<init_meta> method in your class. The
428 C<import> method that C<Moose::Exporter> generates for you will call
429 this method (if it exists). It will always pass the caller to this
430 method via the C<for_class> parameter.
432 Most of the time, your C<init_meta> method will probably just call C<<
433 Moose->init_meta >> to do the real work:
436 shift; # our class name
437 return Moose->init_meta( @_, metaclass => 'My::Metaclass' );
440 =head1 METACLASS TRAITS
442 The C<import> method generated by C<Moose::Exporter> will allow the
443 user of your module to specify metaclass traits in a C<-traits>
444 parameter passed as part of the import:
446 use Moose -traits => 'My::Meta::Trait';
448 use Moose -traits => [ 'My::Meta::Trait', 'My::Other::Trait' ];
450 These traits will be applied to the caller's metaclass
451 instance. Providing traits for an exporting class that does not create
452 a metaclass for the caller is an error.
456 Dave Rolsky E<lt>autarch@urth.orgE<gt>
458 This is largely a reworking of code in Moose.pm originally written by
459 Stevan Little and others.
461 =head1 COPYRIGHT AND LICENSE
463 Copyright 2008 by Infinity Interactive, Inc.
465 L<http://www.iinteractive.com>
467 This library is free software; you can redistribute it and/or modify
468 it under the same terms as Perl itself.