1 package Moose::Exporter;
7 use List::MoreUtils qw( first_index uniq );
8 use Moose::Util::MetaRole;
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 );
35 my $export_recorder = {};
37 my $exports = $class->_make_sub_exporter_params(
38 [ $exporting_package, @exports_from ], $export_recorder );
40 my $exporter = Sub::Exporter::build_exporter(
43 groups => { default => [':all'] }
47 # $args{_export_to_main} exists for backwards compat, because
48 # Moose::Util::TypeConstraints did export to main (unlike Moose &
50 my $import = $class->_make_import_sub( $exporting_package, $exporter,
51 \@exports_from, $args{_export_to_main} );
53 my $unimport = $class->_make_unimport_sub( $exporting_package, $exports,
56 return ( $import, $unimport )
64 my $exporting_package = shift;
66 local %$seen = ( $exporting_package => 1 );
68 return uniq( _follow_also_real($exporting_package) );
71 sub _follow_also_real {
72 my $exporting_package = shift;
74 die "Package in also ($exporting_package) does not seem to use MooseX::Exporter"
75 unless exists $EXPORT_SPEC{$exporting_package};
77 my $also = $EXPORT_SPEC{$exporting_package}{also};
79 return unless defined $also;
81 my @also = ref $also ? @{$also} : $also;
83 for my $package (@also)
85 die "Circular reference in also parameter to MooseX::Exporter between $exporting_package and $package"
88 $seen->{$package} = 1;
91 return @also, map { _follow_also_real($_) } @also;
95 sub _make_sub_exporter_params {
98 my $export_recorder = shift;
102 for my $package ( @{$packages} ) {
103 my $args = $EXPORT_SPEC{$package}
104 or die "The $package package does not use Moose::Exporter\n";
106 for my $name ( @{ $args->{with_caller} } ) {
109 \&{ $package . '::' . $name };
112 my $fq_name = $package . '::' . $name;
114 $exports{$name} = $class->_make_wrapped_sub(
121 for my $name ( @{ $args->{as_is} } ) {
126 $name = ( Class::MOP::get_code_info($name) )[1];
131 \&{ $package . '::' . $name };
135 $export_recorder->{$sub} = 1;
137 $exports{$name} = sub {$sub};
145 # This variable gets closed over in each export _generator_. Then
146 # in the generator we grab the value and close over it _again_ in
147 # the real export, so it gets captured each time the generator
150 # In the meantime, we arrange for the import method we generate to
151 # set this variable to the caller each time it is called.
153 # This is all a bit confusing, but it works.
156 sub _make_wrapped_sub {
160 my $export_recorder = shift;
163 # We need to set the package at import time, so that when
164 # package Foo imports has(), we capture "Foo" as the
165 # package. This lets other packages call Foo::has() and get
166 # the right package. This is done for backwards compatibility
167 # with existing production code, not because this is a good
170 my $caller = $CALLER;
172 my $sub = Class::MOP::subname( $fq_name => sub { $sub->( $caller, @_ ) } );
174 $export_recorder->{$sub} = 1;
180 sub _make_import_sub {
182 my $exporting_package = shift;
183 my $exporter = shift;
184 my $exports_from = shift;
185 my $export_to_main = shift;
188 # I think we could use Sub::Exporter's collector feature
189 # to do this, but that would be rather gross, since that
190 # feature isn't really designed to return a value to the
191 # caller of the exporter sub.
193 # Also, this makes sure we preserve backwards compat for
194 # _get_caller, so it always sees the arguments in the
197 ($traits, @_) = Moose::Exporter::_strip_traits(@_);
199 # Normally we could look at $_[0], but in some weird cases
200 # (involving goto &Moose::import), $_[0] ends as something
201 # else (like Squirrel).
202 my $class = $exporting_package;
204 $CALLER = Moose::Exporter::_get_caller(@_);
206 # this works because both pragmas set $^H (see perldoc
207 # perlvar) which affects the current compilation -
208 # i.e. the file who use'd us - which is why we don't need
209 # to do anything special to make it affect that file
210 # rather than this one (which is already compiled)
215 # we should never export to main
216 if ( $CALLER eq 'main' && ! $export_to_main ) {
218 qq{$class does not export its sugar to the 'main' package.\n};
223 for my $c ( grep { $_->can('init_meta') } $class, @{$exports_from} ) {
225 $c->init_meta( for_class => $CALLER );
229 if ( $did_init_meta && @{$traits} ) {
230 _apply_meta_traits( $CALLER, $traits );
232 elsif ( @{$traits} ) {
233 Moose->throw_error("Cannot provide traits when $class does not have an init_meta() method");
242 my $idx = first_index { $_ eq '-traits' } @_;
244 return ( [], @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
246 my $traits = $_[ $idx + 1 ];
250 $traits = [ $traits ] unless ref $traits;
252 return ( $traits, @_ );
255 sub _apply_meta_traits {
256 my ( $class, $traits ) = @_;
258 return unless @{$traits};
260 my $meta = $class->meta();
262 my $type = ( split /::/, ref $meta )[-1]
263 or Moose->throw_error(
264 'Cannot determine metaclass type for trait application . Meta isa '
268 = map { Moose::Util::resolve_metatrait_alias( $type => $_ ) }
271 return unless @resolved_traits;
273 Moose::Util::MetaRole::apply_metaclass_roles(
275 metaclass_roles => \@resolved_traits,
280 # 1 extra level because it's called by import so there's a layer
285 ( ref $_[1] && defined $_[1]->{into} ) ? $_[1]->{into}
286 : ( ref $_[1] && defined $_[1]->{into_level} )
287 ? caller( $offset + $_[1]->{into_level} )
291 sub _make_unimport_sub {
293 my $exporting_package = shift;
295 my $export_recorder = shift;
298 my $caller = scalar caller();
299 Moose::Exporter->_remove_keywords(
301 [ keys %{$exports} ],
307 sub _remove_keywords {
310 my $keywords = shift;
311 my $recorded_exports = shift;
315 foreach my $name ( @{ $keywords } ) {
317 if ( defined &{ $package . '::' . $name } ) {
318 my $sub = \&{ $package . '::' . $name };
320 # make sure it is from us
321 next unless $recorded_exports->{$sub};
323 # and if it is from us, then undef the slot
324 delete ${ $package . '::' }{$name};
335 Moose::Exporter - make an import() and unimport() just like Moose.pm
339 package MyApp::Moose;
347 Moose::Exporter->setup_import_methods(
348 with_caller => [ 'sugar1', 'sugar2' ],
349 as_is => [ 'sugar3', \&Some::Random::thing ],
359 sugar1 'do your thing';
366 This module encapsulates the logic to export sugar functions like
367 C<Moose.pm>. It does this by building custom C<import> and C<unimport>
368 methods for your module, based on a spec your provide.
370 It also lets your "stack" Moose-alike modules so you can export
371 Moose's sugar as well as your own, along with sugar from any random
372 C<MooseX> module, as long as they all use C<Moose::Exporter>.
376 This module provides two public methods:
378 =head2 Moose::Exporter->setup_import_methods(...)
380 When you call this method, C<Moose::Exporter> build custom C<import>
381 and C<unimport> methods for your module. The import method will export
382 the functions you specify, and you can also tell it to export
383 functions exported by some other module (like C<Moose.pm>).
385 The C<unimport> method cleans the callers namespace of all the
388 This method accepts the following parameters:
392 =item * with_caller => [ ... ]
394 This a list of function I<names only> to be exported wrapped and then
395 exported. The wrapper will pass the name of the calling package as the
396 first argument to the function. Many sugar functions need to know
397 their caller so they can get the calling package's metaclass object.
399 =item * as_is => [ ... ]
401 This a list of function names or sub references to be exported
402 as-is. You can identify a subroutine by reference, which is handy to
403 re-export some other module's functions directly by reference
404 (C<\&Some::Package::function>).
406 =item * also => $name or \@names
408 This is a list of modules which contain functions that the caller
409 wants to export. These modules must also use C<Moose::Exporter>. The
410 most common use case will be to export the functions from C<Moose.pm>.
412 C<Moose::Exporter> also makes sure all these functions get removed
413 when C<unimport> is called.
417 =head2 Moose::Exporter->build_import_methods(...)
419 Returns two code refs, one for import and one for unimport.
421 Used by C<setup_import_methods>.
423 =head1 IMPORTING AND init_meta
425 If you want to set an alternative base object class or metaclass
426 class, simply define an C<init_meta> method in your class. The
427 C<import> method that C<Moose::Exporter> generates for you will call
428 this method (if it exists). It will always pass the caller to this
429 method via the C<for_class> parameter.
431 Most of the time, your C<init_meta> method will probably just call C<<
432 Moose->init_meta >> to do the real work:
435 shift; # our class name
436 return Moose->init_meta( @_, metaclass => 'My::Metaclass' );
439 =head1 METACLASS TRAITS
441 The C<import> method generated by C<Moose::Exporter> will allow the
442 user of your module to specify metaclass traits in a C<-traits>
443 parameter passed as part of the import:
445 use Moose -traits => 'My::Meta::Trait';
447 use Moose -traits => [ 'My::Meta::Trait', 'My::Other::Trait' ];
449 These traits will be applied to the caller's metaclass
450 instance. Providing traits for an exporting class that does not create
451 a metaclass for the caller is an error.
455 Dave Rolsky E<lt>autarch@urth.orgE<gt>
457 This is largely a reworking of code in Moose.pm originally written by
458 Stevan Little and others.
460 =head1 COPYRIGHT AND LICENSE
462 Copyright 2008 by Infinity Interactive, Inc.
464 L<http://www.iinteractive.com>
466 This library is free software; you can redistribute it and/or modify
467 it under the same terms as Perl itself.