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 );
166 sub _make_wrapped_sub {
170 my $export_recorder = shift;
172 # We need to set the package at import time, so that when
173 # package Foo imports has(), we capture "Foo" as the
174 # package. This lets other packages call Foo::has() and get
175 # the right package. This is done for backwards compatibility
176 # with existing production code, not because this is a good
179 my $caller = $CALLER;
182 = Class::MOP::subname( $fq_name => sub { $sub->( $caller, @_ ) } );
184 $export_recorder->{$sub} = 1;
190 sub _make_import_sub {
192 my $exporting_package = shift;
193 my $exporter = shift;
194 my $exports_from = shift;
195 my $export_to_main = shift;
199 # I think we could use Sub::Exporter's collector feature
200 # to do this, but that would be rather gross, since that
201 # feature isn't really designed to return a value to the
202 # caller of the exporter sub.
204 # Also, this makes sure we preserve backwards compat for
205 # _get_caller, so it always sees the arguments in the
208 ( $traits, @_ ) = _strip_traits(@_);
210 # Normally we could look at $_[0], but in some weird cases
211 # (involving goto &Moose::import), $_[0] ends as something
212 # else (like Squirrel).
213 my $class = $exporting_package;
215 $CALLER = _get_caller(@_);
217 # this works because both pragmas set $^H (see perldoc
218 # perlvar) which affects the current compilation -
219 # i.e. the file who use'd us - which is why we don't need
220 # to do anything special to make it affect that file
221 # rather than this one (which is already compiled)
226 # we should never export to main
227 if ( $CALLER eq 'main' && !$export_to_main ) {
229 qq{$class does not export its sugar to the 'main' package.\n};
234 for my $c ( grep { $_->can('init_meta') } $class, @{$exports_from} ) {
235 $c->init_meta( for_class => $CALLER );
239 if ( $did_init_meta && @{$traits} ) {
240 # The traits will use Moose::Role, which in turn uses
241 # Moose::Exporter, which in turn sets $CALLER, so we need
242 # to protect against that.
243 local $CALLER = $CALLER;
244 _apply_meta_traits( $CALLER, $traits );
246 elsif ( @{$traits} ) {
248 "Cannot provide traits when $class does not have an init_meta() method"
258 my $idx = first_index { $_ eq '-traits' } @_;
260 return ( [], @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
262 my $traits = $_[ $idx + 1 ];
266 $traits = [ $traits ] unless ref $traits;
268 return ( $traits, @_ );
271 sub _apply_meta_traits {
272 my ( $class, $traits ) = @_;
274 return unless @{$traits};
276 my $meta = $class->meta();
278 my $type = ( split /::/, ref $meta )[-1]
279 or Moose->throw_error(
280 'Cannot determine metaclass type for trait application . Meta isa '
284 = map { Moose::Util::resolve_metatrait_alias( $type => $_ ) }
287 return unless @resolved_traits;
289 Moose::Util::MetaRole::apply_metaclass_roles(
291 metaclass_roles => \@resolved_traits,
296 # 1 extra level because it's called by import so there's a layer
301 ( ref $_[1] && defined $_[1]->{into} ) ? $_[1]->{into}
302 : ( ref $_[1] && defined $_[1]->{into_level} )
303 ? caller( $offset + $_[1]->{into_level} )
307 sub _make_unimport_sub {
309 my $exporting_package = shift;
311 my $is_removable = shift;
312 my $export_recorder = shift;
315 my $caller = scalar caller();
316 Moose::Exporter->_remove_keywords(
318 [ keys %{$exports} ],
325 sub _remove_keywords {
328 my $keywords = shift;
329 my $is_removable = shift;
330 my $recorded_exports = shift;
334 foreach my $name ( @{ $keywords } ) {
335 next unless $is_removable->{$name};
337 if ( defined &{ $package . '::' . $name } ) {
338 my $sub = \&{ $package . '::' . $name };
340 # make sure it is from us
341 next unless $recorded_exports->{$sub};
343 # and if it is from us, then undef the slot
344 delete ${ $package . '::' }{$name};
355 Moose::Exporter - make an import() and unimport() just like Moose.pm
359 package MyApp::Moose;
367 Moose::Exporter->setup_import_methods(
368 with_caller => [ 'has_rw', 'sugar2' ],
369 as_is => [ 'sugar3', \&Some::Random::thing ],
374 my ($caller, $name, %options) = @_;
375 Class::MOP::Class->initialize($caller)->add_attribute($name,
394 This module encapsulates the logic to export sugar functions like
395 C<Moose.pm>. It does this by building custom C<import> and C<unimport>
396 methods for your module, based on a spec your provide.
398 It also lets your "stack" Moose-alike modules so you can export
399 Moose's sugar as well as your own, along with sugar from any random
400 C<MooseX> module, as long as they all use C<Moose::Exporter>.
404 This module provides two public methods:
406 =head2 Moose::Exporter->setup_import_methods(...)
408 When you call this method, C<Moose::Exporter> build custom C<import>
409 and C<unimport> methods for your module. The import method will export
410 the functions you specify, and you can also tell it to export
411 functions exported by some other module (like C<Moose.pm>).
413 The C<unimport> method cleans the callers namespace of all the
416 This method accepts the following parameters:
420 =item * with_caller => [ ... ]
422 This a list of function I<names only> to be exported wrapped and then
423 exported. The wrapper will pass the name of the calling package as the
424 first argument to the function. Many sugar functions need to know
425 their caller so they can get the calling package's metaclass object.
427 =item * as_is => [ ... ]
429 This a list of function names or sub references to be exported
430 as-is. You can identify a subroutine by reference, which is handy to
431 re-export some other module's functions directly by reference
432 (C<\&Some::Package::function>).
434 If you do export some other packages function, this function will
435 never be removed by the C<unimport> method. The reason for this is we
436 cannot know if the caller I<also> explicitly imported the sub
437 themselves, and therefore wants to keep it.
439 =item * also => $name or \@names
441 This is a list of modules which contain functions that the caller
442 wants to export. These modules must also use C<Moose::Exporter>. The
443 most common use case will be to export the functions from C<Moose.pm>.
445 C<Moose::Exporter> also makes sure all these functions get removed
446 when C<unimport> is called.
450 =head2 Moose::Exporter->build_import_methods(...)
452 Returns two code refs, one for import and one for unimport.
454 Used by C<setup_import_methods>.
456 =head1 IMPORTING AND init_meta
458 If you want to set an alternative base object class or metaclass
459 class, simply define an C<init_meta> method in your class. The
460 C<import> method that C<Moose::Exporter> generates for you will call
461 this method (if it exists). It will always pass the caller to this
462 method via the C<for_class> parameter.
464 Most of the time, your C<init_meta> method will probably just call C<<
465 Moose->init_meta >> to do the real work:
468 shift; # our class name
469 return Moose->init_meta( @_, metaclass => 'My::Metaclass' );
472 =head1 METACLASS TRAITS
474 The C<import> method generated by C<Moose::Exporter> will allow the
475 user of your module to specify metaclass traits in a C<-traits>
476 parameter passed as part of the import:
478 use Moose -traits => 'My::Meta::Trait';
480 use Moose -traits => [ 'My::Meta::Trait', 'My::Other::Trait' ];
482 These traits will be applied to the caller's metaclass
483 instance. Providing traits for an exporting class that does not create
484 a metaclass for the caller is an error.
488 Dave Rolsky E<lt>autarch@urth.orgE<gt>
490 This is largely a reworking of code in Moose.pm originally written by
491 Stevan Little and others.
493 =head1 COPYRIGHT AND LICENSE
495 Copyright 2008 by Infinity Interactive, Inc.
497 L<http://www.iinteractive.com>
499 This library is free software; you can redistribute it and/or modify
500 it under the same terms as Perl itself.