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, $is_removable )
38 = $class->_make_sub_exporter_params(
39 [ $exporting_package, @exports_from ], $export_recorder );
41 my $exporter = Sub::Exporter::build_exporter(
44 groups => { default => [':all'] }
48 # $args{_export_to_main} exists for backwards compat, because
49 # Moose::Util::TypeConstraints did export to main (unlike Moose &
51 my $import = $class->_make_import_sub( $exporting_package, $exporter,
52 \@exports_from, $args{_export_to_main} );
54 my $unimport = $class->_make_unimport_sub( $exporting_package, $exports,
55 $is_removable, $export_recorder );
57 return ( $import, $unimport )
65 my $exporting_package = shift;
67 local %$seen = ( $exporting_package => 1 );
69 return uniq( _follow_also_real($exporting_package) );
72 sub _follow_also_real {
73 my $exporting_package = shift;
75 die "Package in also ($exporting_package) does not seem to use Moose::Exporter"
76 unless exists $EXPORT_SPEC{$exporting_package};
78 my $also = $EXPORT_SPEC{$exporting_package}{also};
80 return unless defined $also;
82 my @also = ref $also ? @{$also} : $also;
84 for my $package (@also)
86 die "Circular reference in also parameter to Moose::Exporter between $exporting_package and $package"
89 $seen->{$package} = 1;
92 return @also, map { _follow_also_real($_) } @also;
96 sub _make_sub_exporter_params {
99 my $export_recorder = shift;
104 for my $package ( @{$packages} ) {
105 my $args = $EXPORT_SPEC{$package}
106 or die "The $package package does not use Moose::Exporter\n";
108 for my $name ( @{ $args->{with_caller} } ) {
111 \&{ $package . '::' . $name };
114 my $fq_name = $package . '::' . $name;
116 $exports{$name} = $class->_make_wrapped_sub(
122 $is_removable{$name} = 1;
125 for my $name ( @{ $args->{as_is} } ) {
131 # Even though Moose re-exports things from Carp &
132 # Scalar::Util, we don't want to remove those at
133 # unimport time, because the importing package may
134 # have imported them explicitly ala
136 # use Carp qw( confess );
138 # This is a hack. Since we can't know whether they
139 # really want to keep these subs or not, we err on the
140 # safe side and leave them in.
142 ( $coderef_pkg, $name ) = Class::MOP::get_code_info($name);
144 $is_removable{$name} = $coderef_pkg eq $package ? 1 : 0;
149 \&{ $package . '::' . $name };
152 $is_removable{$name} = 1;
155 $export_recorder->{$sub} = 1;
157 $exports{$name} = sub {$sub};
161 return ( \%exports, \%is_removable );
165 # This variable gets closed over in each export _generator_. Then
166 # in the generator we grab the value and close over it _again_ in
167 # the real export, so it gets captured each time the generator
170 # In the meantime, we arrange for the import method we generate to
171 # set this variable to the caller each time it is called.
173 # This is all a bit confusing, but it works.
176 sub _make_wrapped_sub {
180 my $export_recorder = shift;
183 # We need to set the package at import time, so that when
184 # package Foo imports has(), we capture "Foo" as the
185 # package. This lets other packages call Foo::has() and get
186 # the right package. This is done for backwards compatibility
187 # with existing production code, not because this is a good
190 my $caller = $CALLER;
192 my $sub = Class::MOP::subname( $fq_name => sub { $sub->( $caller, @_ ) } );
194 $export_recorder->{$sub} = 1;
200 sub _make_import_sub {
202 my $exporting_package = shift;
203 my $exporter = shift;
204 my $exports_from = shift;
205 my $export_to_main = shift;
208 # I think we could use Sub::Exporter's collector feature
209 # to do this, but that would be rather gross, since that
210 # feature isn't really designed to return a value to the
211 # caller of the exporter sub.
213 # Also, this makes sure we preserve backwards compat for
214 # _get_caller, so it always sees the arguments in the
217 ($traits, @_) = Moose::Exporter::_strip_traits(@_);
219 # Normally we could look at $_[0], but in some weird cases
220 # (involving goto &Moose::import), $_[0] ends as something
221 # else (like Squirrel).
222 my $class = $exporting_package;
224 $CALLER = Moose::Exporter::_get_caller(@_);
226 # this works because both pragmas set $^H (see perldoc
227 # perlvar) which affects the current compilation -
228 # i.e. the file who use'd us - which is why we don't need
229 # to do anything special to make it affect that file
230 # rather than this one (which is already compiled)
235 # we should never export to main
236 if ( $CALLER eq 'main' && ! $export_to_main ) {
238 qq{$class does not export its sugar to the 'main' package.\n};
243 for my $c ( grep { $_->can('init_meta') } $class, @{$exports_from} ) {
245 $c->init_meta( for_class => $CALLER );
249 if ( $did_init_meta && @{$traits} ) {
250 _apply_meta_traits( $CALLER, $traits );
252 elsif ( @{$traits} ) {
253 Moose->throw_error("Cannot provide traits when $class does not have an init_meta() method");
262 my $idx = first_index { $_ eq '-traits' } @_;
264 return ( [], @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
266 my $traits = $_[ $idx + 1 ];
270 $traits = [ $traits ] unless ref $traits;
272 return ( $traits, @_ );
275 sub _apply_meta_traits {
276 my ( $class, $traits ) = @_;
278 return unless @{$traits};
280 my $meta = $class->meta();
282 my $type = ( split /::/, ref $meta )[-1]
283 or Moose->throw_error(
284 'Cannot determine metaclass type for trait application . Meta isa '
288 = map { Moose::Util::resolve_metatrait_alias( $type => $_ ) }
291 return unless @resolved_traits;
293 Moose::Util::MetaRole::apply_metaclass_roles(
295 metaclass_roles => \@resolved_traits,
300 # 1 extra level because it's called by import so there's a layer
305 ( ref $_[1] && defined $_[1]->{into} ) ? $_[1]->{into}
306 : ( ref $_[1] && defined $_[1]->{into_level} )
307 ? caller( $offset + $_[1]->{into_level} )
311 sub _make_unimport_sub {
313 my $exporting_package = shift;
315 my $is_removable = shift;
316 my $export_recorder = shift;
319 my $caller = scalar caller();
320 Moose::Exporter->_remove_keywords(
322 [ keys %{$exports} ],
329 sub _remove_keywords {
332 my $keywords = shift;
333 my $is_removable = shift;
334 my $recorded_exports = shift;
338 foreach my $name ( @{ $keywords } ) {
339 next unless $is_removable->{$name};
341 if ( defined &{ $package . '::' . $name } ) {
342 my $sub = \&{ $package . '::' . $name };
344 # make sure it is from us
345 next unless $recorded_exports->{$sub};
347 # and if it is from us, then undef the slot
348 delete ${ $package . '::' }{$name};
359 Moose::Exporter - make an import() and unimport() just like Moose.pm
363 package MyApp::Moose;
371 Moose::Exporter->setup_import_methods(
372 with_caller => [ 'has_rw', 'sugar2' ],
373 as_is => [ 'sugar3', \&Some::Random::thing ],
378 my ($caller, $name, %options) = @_;
379 Class::MOP::Class->initialize($caller)->add_attribute($name,
398 This module encapsulates the logic to export sugar functions like
399 C<Moose.pm>. It does this by building custom C<import> and C<unimport>
400 methods for your module, based on a spec your provide.
402 It also lets your "stack" Moose-alike modules so you can export
403 Moose's sugar as well as your own, along with sugar from any random
404 C<MooseX> module, as long as they all use C<Moose::Exporter>.
408 This module provides two public methods:
410 =head2 Moose::Exporter->setup_import_methods(...)
412 When you call this method, C<Moose::Exporter> build custom C<import>
413 and C<unimport> methods for your module. The import method will export
414 the functions you specify, and you can also tell it to export
415 functions exported by some other module (like C<Moose.pm>).
417 The C<unimport> method cleans the callers namespace of all the
420 This method accepts the following parameters:
424 =item * with_caller => [ ... ]
426 This a list of function I<names only> to be exported wrapped and then
427 exported. The wrapper will pass the name of the calling package as the
428 first argument to the function. Many sugar functions need to know
429 their caller so they can get the calling package's metaclass object.
431 =item * as_is => [ ... ]
433 This a list of function names or sub references to be exported
434 as-is. You can identify a subroutine by reference, which is handy to
435 re-export some other module's functions directly by reference
436 (C<\&Some::Package::function>).
438 If you do export some other packages function, this function will
439 never be removed by the C<unimport> method. The reason for this is we
440 cannot know if the caller I<also> explicitly imported the sub
441 themselves, and therefore wants to keep it.
443 =item * also => $name or \@names
445 This is a list of modules which contain functions that the caller
446 wants to export. These modules must also use C<Moose::Exporter>. The
447 most common use case will be to export the functions from C<Moose.pm>.
449 C<Moose::Exporter> also makes sure all these functions get removed
450 when C<unimport> is called.
454 =head2 Moose::Exporter->build_import_methods(...)
456 Returns two code refs, one for import and one for unimport.
458 Used by C<setup_import_methods>.
460 =head1 IMPORTING AND init_meta
462 If you want to set an alternative base object class or metaclass
463 class, simply define an C<init_meta> method in your class. The
464 C<import> method that C<Moose::Exporter> generates for you will call
465 this method (if it exists). It will always pass the caller to this
466 method via the C<for_class> parameter.
468 Most of the time, your C<init_meta> method will probably just call C<<
469 Moose->init_meta >> to do the real work:
472 shift; # our class name
473 return Moose->init_meta( @_, metaclass => 'My::Metaclass' );
476 =head1 METACLASS TRAITS
478 The C<import> method generated by C<Moose::Exporter> will allow the
479 user of your module to specify metaclass traits in a C<-traits>
480 parameter passed as part of the import:
482 use Moose -traits => 'My::Meta::Trait';
484 use Moose -traits => [ 'My::Meta::Trait', 'My::Other::Trait' ];
486 These traits will be applied to the caller's metaclass
487 instance. Providing traits for an exporting class that does not create
488 a metaclass for the caller is an error.
492 Dave Rolsky E<lt>autarch@urth.orgE<gt>
494 This is largely a reworking of code in Moose.pm originally written by
495 Stevan Little and others.
497 =head1 COPYRIGHT AND LICENSE
499 Copyright 2008 by Infinity Interactive, Inc.
501 L<http://www.iinteractive.com>
503 This library is free software; you can redistribute it and/or modify
504 it under the same terms as Perl itself.