1 package Moose::Exporter;
7 $VERSION = eval $VERSION;
8 our $AUTHORITY = 'cpan:STEVAN';
11 use List::MoreUtils qw( first_index uniq );
12 use Moose::Util::MetaRole;
18 sub setup_import_methods {
19 my ( $class, %args ) = @_;
21 my $exporting_package = $args{exporting_package} ||= caller();
23 my ( $import, $unimport ) = $class->build_import_methods(%args);
26 *{ $exporting_package . '::import' } = $import;
27 *{ $exporting_package . '::unimport' } = $unimport;
30 sub build_import_methods {
31 my ( $class, %args ) = @_;
33 my $exporting_package = $args{exporting_package} ||= caller();
35 $EXPORT_SPEC{$exporting_package} = \%args;
37 my @exports_from = $class->_follow_also( $exporting_package );
39 my $export_recorder = {};
41 my ( $exports, $is_removable )
42 = $class->_make_sub_exporter_params(
43 [ $exporting_package, @exports_from ], $export_recorder );
45 my $exporter = Sub::Exporter::build_exporter(
48 groups => { default => [':all'] }
52 # $args{_export_to_main} exists for backwards compat, because
53 # Moose::Util::TypeConstraints did export to main (unlike Moose &
55 my $import = $class->_make_import_sub( $exporting_package, $exporter,
56 \@exports_from, $args{_export_to_main} );
58 my $unimport = $class->_make_unimport_sub( $exporting_package, $exports,
59 $is_removable, $export_recorder );
61 return ( $import, $unimport )
69 my $exporting_package = shift;
71 local %$seen = ( $exporting_package => 1 );
73 return uniq( _follow_also_real($exporting_package) );
76 sub _follow_also_real {
77 my $exporting_package = shift;
79 die "Package in also ($exporting_package) does not seem to use Moose::Exporter"
80 unless exists $EXPORT_SPEC{$exporting_package};
82 my $also = $EXPORT_SPEC{$exporting_package}{also};
84 return unless defined $also;
86 my @also = ref $also ? @{$also} : $also;
88 for my $package (@also)
90 die "Circular reference in also parameter to Moose::Exporter between $exporting_package and $package"
93 $seen->{$package} = 1;
96 return @also, map { _follow_also_real($_) } @also;
100 sub _make_sub_exporter_params {
102 my $packages = shift;
103 my $export_recorder = shift;
108 for my $package ( @{$packages} ) {
109 my $args = $EXPORT_SPEC{$package}
110 or die "The $package package does not use Moose::Exporter\n";
112 for my $name ( @{ $args->{with_caller} } ) {
115 \&{ $package . '::' . $name };
118 my $fq_name = $package . '::' . $name;
120 $exports{$name} = $class->_make_wrapped_sub(
126 $is_removable{$name} = 1;
129 for my $name ( @{ $args->{as_is} } ) {
135 # Even though Moose re-exports things from Carp &
136 # Scalar::Util, we don't want to remove those at
137 # unimport time, because the importing package may
138 # have imported them explicitly ala
140 # use Carp qw( confess );
142 # This is a hack. Since we can't know whether they
143 # really want to keep these subs or not, we err on the
144 # safe side and leave them in.
146 ( $coderef_pkg, $name ) = Class::MOP::get_code_info($name);
148 $is_removable{$name} = $coderef_pkg eq $package ? 1 : 0;
153 \&{ $package . '::' . $name };
156 $is_removable{$name} = 1;
159 $export_recorder->{$sub} = 1;
161 $exports{$name} = sub {$sub};
165 return ( \%exports, \%is_removable );
170 sub _make_wrapped_sub {
174 my $export_recorder = shift;
176 # We need to set the package at import time, so that when
177 # package Foo imports has(), we capture "Foo" as the
178 # package. This lets other packages call Foo::has() and get
179 # the right package. This is done for backwards compatibility
180 # with existing production code, not because this is a good
183 my $caller = $CALLER;
185 my $wrapper = $self->_make_wrapper($caller, $sub, $fq_name);
187 my $sub = Class::MOP::subname($fq_name => $wrapper);
189 $export_recorder->{$sub} = 1;
201 return sub { $sub->($caller, @_) };
204 sub _make_import_sub {
206 my $exporting_package = shift;
207 my $exporter = shift;
208 my $exports_from = shift;
209 my $export_to_main = shift;
213 # I think we could use Sub::Exporter's collector feature
214 # to do this, but that would be rather gross, since that
215 # feature isn't really designed to return a value to the
216 # caller of the exporter sub.
218 # Also, this makes sure we preserve backwards compat for
219 # _get_caller, so it always sees the arguments in the
222 ( $traits, @_ ) = _strip_traits(@_);
224 # Normally we could look at $_[0], but in some weird cases
225 # (involving goto &Moose::import), $_[0] ends as something
226 # else (like Squirrel).
227 my $class = $exporting_package;
229 $CALLER = _get_caller(@_);
231 # this works because both pragmas set $^H (see perldoc
232 # perlvar) which affects the current compilation -
233 # i.e. the file who use'd us - which is why we don't need
234 # to do anything special to make it affect that file
235 # rather than this one (which is already compiled)
240 # we should never export to main
241 if ( $CALLER eq 'main' && !$export_to_main ) {
243 qq{$class does not export its sugar to the 'main' package.\n};
248 for my $c ( grep { $_->can('init_meta') } $class, @{$exports_from} ) {
249 local $CALLER = $CALLER;
250 $c->init_meta( for_class => $CALLER );
254 if ( $did_init_meta && @{$traits} ) {
255 # The traits will use Moose::Role, which in turn uses
256 # Moose::Exporter, which in turn sets $CALLER, so we need
257 # to protect against that.
258 local $CALLER = $CALLER;
259 _apply_meta_traits( $CALLER, $traits );
261 elsif ( @{$traits} ) {
263 "Cannot provide traits when $class does not have an init_meta() method"
273 my $idx = first_index { $_ eq '-traits' } @_;
275 return ( [], @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
277 my $traits = $_[ $idx + 1 ];
281 $traits = [ $traits ] unless ref $traits;
283 return ( $traits, @_ );
286 sub _apply_meta_traits {
287 my ( $class, $traits ) = @_;
289 return unless @{$traits};
291 my $meta = $class->meta();
293 my $type = ( split /::/, ref $meta )[-1]
294 or Moose->throw_error(
295 'Cannot determine metaclass type for trait application . Meta isa '
299 = map { Moose::Util::resolve_metatrait_alias( $type => $_ ) }
302 return unless @resolved_traits;
304 Moose::Util::MetaRole::apply_metaclass_roles(
306 metaclass_roles => \@resolved_traits,
311 # 1 extra level because it's called by import so there's a layer
316 ( ref $_[1] && defined $_[1]->{into} ) ? $_[1]->{into}
317 : ( ref $_[1] && defined $_[1]->{into_level} )
318 ? caller( $offset + $_[1]->{into_level} )
322 sub _make_unimport_sub {
324 my $exporting_package = shift;
326 my $is_removable = shift;
327 my $export_recorder = shift;
330 my $caller = scalar caller();
331 Moose::Exporter->_remove_keywords(
333 [ keys %{$exports} ],
340 sub _remove_keywords {
343 my $keywords = shift;
344 my $is_removable = shift;
345 my $recorded_exports = shift;
349 foreach my $name ( @{ $keywords } ) {
350 next unless $is_removable->{$name};
352 if ( defined &{ $package . '::' . $name } ) {
353 my $sub = \&{ $package . '::' . $name };
355 # make sure it is from us
356 next unless $recorded_exports->{$sub};
358 # and if it is from us, then undef the slot
359 delete ${ $package . '::' }{$name};
370 Moose::Exporter - make an import() and unimport() just like Moose.pm
374 package MyApp::Moose;
382 Moose::Exporter->setup_import_methods(
383 with_caller => [ 'has_rw', 'sugar2' ],
384 as_is => [ 'sugar3', \&Some::Random::thing ],
389 my ($caller, $name, %options) = @_;
390 Class::MOP::Class->initialize($caller)->add_attribute($name,
409 This module encapsulates the logic to export sugar functions like
410 C<Moose.pm>. It does this by building custom C<import> and C<unimport>
411 methods for your module, based on a spec your provide.
413 It also lets your "stack" Moose-alike modules so you can export
414 Moose's sugar as well as your own, along with sugar from any random
415 C<MooseX> module, as long as they all use C<Moose::Exporter>.
419 This module provides two public methods:
421 =head2 Moose::Exporter->setup_import_methods(...)
423 When you call this method, C<Moose::Exporter> build custom C<import>
424 and C<unimport> methods for your module. The import method will export
425 the functions you specify, and you can also tell it to export
426 functions exported by some other module (like C<Moose.pm>).
428 The C<unimport> method cleans the callers namespace of all the
431 This method accepts the following parameters:
435 =item * with_caller => [ ... ]
437 This a list of function I<names only> to be exported wrapped and then
438 exported. The wrapper will pass the name of the calling package as the
439 first argument to the function. Many sugar functions need to know
440 their caller so they can get the calling package's metaclass object.
442 =item * as_is => [ ... ]
444 This a list of function names or sub references to be exported
445 as-is. You can identify a subroutine by reference, which is handy to
446 re-export some other module's functions directly by reference
447 (C<\&Some::Package::function>).
449 If you do export some other packages function, this function will
450 never be removed by the C<unimport> method. The reason for this is we
451 cannot know if the caller I<also> explicitly imported the sub
452 themselves, and therefore wants to keep it.
454 =item * also => $name or \@names
456 This is a list of modules which contain functions that the caller
457 wants to export. These modules must also use C<Moose::Exporter>. The
458 most common use case will be to export the functions from C<Moose.pm>.
460 C<Moose::Exporter> also makes sure all these functions get removed
461 when C<unimport> is called.
465 =head2 Moose::Exporter->build_import_methods(...)
467 Returns two code refs, one for import and one for unimport.
469 Used by C<setup_import_methods>.
471 =head1 IMPORTING AND init_meta
473 If you want to set an alternative base object class or metaclass
474 class, simply define an C<init_meta> method in your class. The
475 C<import> method that C<Moose::Exporter> generates for you will call
476 this method (if it exists). It will always pass the caller to this
477 method via the C<for_class> parameter.
479 Most of the time, your C<init_meta> method will probably just call C<<
480 Moose->init_meta >> to do the real work:
483 shift; # our class name
484 return Moose->init_meta( @_, metaclass => 'My::Metaclass' );
487 =head1 METACLASS TRAITS
489 The C<import> method generated by C<Moose::Exporter> will allow the
490 user of your module to specify metaclass traits in a C<-traits>
491 parameter passed as part of the import:
493 use Moose -traits => 'My::Meta::Trait';
495 use Moose -traits => [ 'My::Meta::Trait', 'My::Other::Trait' ];
497 These traits will be applied to the caller's metaclass
498 instance. Providing traits for an exporting class that does not create
499 a metaclass for the caller is an error.
503 Dave Rolsky E<lt>autarch@urth.orgE<gt>
505 This is largely a reworking of code in Moose.pm originally written by
506 Stevan Little and others.
508 =head1 COPYRIGHT AND LICENSE
510 Copyright 2008 by Infinity Interactive, Inc.
512 L<http://www.iinteractive.com>
514 This library is free software; you can redistribute it and/or modify
515 it under the same terms as Perl itself.