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;
14 use Sub::Name qw(subname);
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 [ @exports_from, $exporting_package ], $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 = subname($fq_name => $wrapper);
189 $export_recorder->{$sub} = 1;
201 my $wrapper = sub { $sub->($caller, @_) };
202 if (my $proto = prototype $sub) {
203 # XXX - Perl's prototype sucks. Use & to make set_prototype
204 # ignore the fact that we're passing a "provate variable"
205 &Scalar::Util::set_prototype($wrapper, $proto);
210 sub _make_import_sub {
212 my $exporting_package = shift;
213 my $exporter = shift;
214 my $exports_from = shift;
215 my $export_to_main = shift;
219 # I think we could use Sub::Exporter's collector feature
220 # to do this, but that would be rather gross, since that
221 # feature isn't really designed to return a value to the
222 # caller of the exporter sub.
224 # Also, this makes sure we preserve backwards compat for
225 # _get_caller, so it always sees the arguments in the
228 ( $traits, @_ ) = _strip_traits(@_);
231 ( $metaclass, @_ ) = _strip_metaclass(@_);
233 # Normally we could look at $_[0], but in some weird cases
234 # (involving goto &Moose::import), $_[0] ends as something
235 # else (like Squirrel).
236 my $class = $exporting_package;
238 $CALLER = _get_caller(@_);
240 # this works because both pragmas set $^H (see perldoc
241 # perlvar) which affects the current compilation -
242 # i.e. the file who use'd us - which is why we don't need
243 # to do anything special to make it affect that file
244 # rather than this one (which is already compiled)
249 # we should never export to main
250 if ( $CALLER eq 'main' && !$export_to_main ) {
252 qq{$class does not export its sugar to the 'main' package.\n};
257 for my $c ( grep { $_->can('init_meta') } $class, @{$exports_from} ) {
258 # init_meta can apply a role, which when loaded uses
259 # Moose::Exporter, which in turn sets $CALLER, so we need
260 # to protect against that.
261 local $CALLER = $CALLER;
262 $c->init_meta( for_class => $CALLER, metaclass => $metaclass );
266 if ( $did_init_meta && @{$traits} ) {
267 # The traits will use Moose::Role, which in turn uses
268 # Moose::Exporter, which in turn sets $CALLER, so we need
269 # to protect against that.
270 local $CALLER = $CALLER;
271 _apply_meta_traits( $CALLER, $traits );
273 elsif ( @{$traits} ) {
276 "Cannot provide traits when $class does not have an init_meta() method"
286 my $idx = first_index { $_ eq '-traits' } @_;
288 return ( [], @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
290 my $traits = $_[ $idx + 1 ];
294 $traits = [ $traits ] unless ref $traits;
296 return ( $traits, @_ );
299 sub _strip_metaclass {
300 my $idx = first_index { $_ eq '-metaclass' } @_;
302 return ( undef, @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
304 my $metaclass = $_[ $idx + 1 ];
308 return ( $metaclass, @_ );
311 sub _apply_meta_traits {
312 my ( $class, $traits ) = @_;
314 return unless @{$traits};
316 my $meta = Class::MOP::class_of($class);
318 my $type = ( split /::/, ref $meta )[-1]
319 or Moose->throw_error(
320 'Cannot determine metaclass type for trait application . Meta isa '
324 = map { Moose::Util::resolve_metatrait_alias( $type => $_ ) }
327 return unless @resolved_traits;
329 Moose::Util::MetaRole::apply_metaclass_roles(
331 metaclass_roles => \@resolved_traits,
336 # 1 extra level because it's called by import so there's a layer
341 ( ref $_[1] && defined $_[1]->{into} ) ? $_[1]->{into}
342 : ( ref $_[1] && defined $_[1]->{into_level} )
343 ? caller( $offset + $_[1]->{into_level} )
347 sub _make_unimport_sub {
349 my $exporting_package = shift;
351 my $is_removable = shift;
352 my $export_recorder = shift;
355 my $caller = scalar caller();
356 Moose::Exporter->_remove_keywords(
358 [ keys %{$exports} ],
365 sub _remove_keywords {
368 my $keywords = shift;
369 my $is_removable = shift;
370 my $recorded_exports = shift;
374 foreach my $name ( @{ $keywords } ) {
375 next unless $is_removable->{$name};
377 if ( defined &{ $package . '::' . $name } ) {
378 my $sub = \&{ $package . '::' . $name };
380 # make sure it is from us
381 next unless $recorded_exports->{$sub};
383 # and if it is from us, then undef the slot
384 delete ${ $package . '::' }{$name};
400 Moose::Exporter - make an import() and unimport() just like Moose.pm
404 package MyApp::Moose;
409 Moose::Exporter->setup_import_methods(
410 with_caller => [ 'has_rw', 'sugar2' ],
411 as_is => [ 'sugar3', \&Some::Random::thing ],
416 my ($caller, $name, %options) = @_;
417 Class::MOP::Class->initialize($caller)->add_attribute($name,
436 This module encapsulates the exporting of sugar functions in a
437 C<Moose.pm>-like manner. It does this by building custom C<import> and
438 C<unimport> methods for your module, based on a spec you provide.
440 It also lets you "stack" Moose-alike modules so you can export
441 Moose's sugar as well as your own, along with sugar from any random
442 C<MooseX> module, as long as they all use C<Moose::Exporter>.
444 To simplify writing exporter modules, C<Moose::Exporter> also imports
445 C<strict> and C<warnings> into your exporter module, as well as into
450 This module provides two public methods:
454 =item B<< Moose::Exporter->setup_import_methods(...) >>
456 When you call this method, C<Moose::Exporter> build custom C<import>
457 and C<unimport> methods for your module. The import method will export
458 the functions you specify, and you can also tell it to export
459 functions exported by some other module (like C<Moose.pm>).
461 The C<unimport> method cleans the callers namespace of all the
464 This method accepts the following parameters:
468 =item * with_caller => [ ... ]
470 This a list of function I<names only> to be exported wrapped and then
471 exported. The wrapper will pass the name of the calling package as the
472 first argument to the function. Many sugar functions need to know
473 their caller so they can get the calling package's metaclass object.
475 =item * as_is => [ ... ]
477 This a list of function names or sub references to be exported
478 as-is. You can identify a subroutine by reference, which is handy to
479 re-export some other module's functions directly by reference
480 (C<\&Some::Package::function>).
482 If you do export some other packages function, this function will
483 never be removed by the C<unimport> method. The reason for this is we
484 cannot know if the caller I<also> explicitly imported the sub
485 themselves, and therefore wants to keep it.
487 =item * also => $name or \@names
489 This is a list of modules which contain functions that the caller
490 wants to export. These modules must also use C<Moose::Exporter>. The
491 most common use case will be to export the functions from C<Moose.pm>.
492 Functions specified by C<with_caller> or C<as_is> take precedence over
493 functions exported by modules specified by C<also>, so that a module
494 can selectively override functions exported by another module.
496 C<Moose::Exporter> also makes sure all these functions get removed
497 when C<unimport> is called.
501 =item B<< Moose::Exporter->build_import_methods(...) >>
503 Returns two code refs, one for import and one for unimport.
505 Used by C<setup_import_methods>.
509 =head1 IMPORTING AND init_meta
511 If you want to set an alternative base object class or metaclass
512 class, simply define an C<init_meta> method in your class. The
513 C<import> method that C<Moose::Exporter> generates for you will call
514 this method (if it exists). It will always pass the caller to this
515 method via the C<for_class> parameter.
517 Most of the time, your C<init_meta> method will probably just call C<<
518 Moose->init_meta >> to do the real work:
521 shift; # our class name
522 return Moose->init_meta( @_, metaclass => 'My::Metaclass' );
525 =head1 METACLASS TRAITS
527 The C<import> method generated by C<Moose::Exporter> will allow the
528 user of your module to specify metaclass traits in a C<-traits>
529 parameter passed as part of the import:
531 use Moose -traits => 'My::Meta::Trait';
533 use Moose -traits => [ 'My::Meta::Trait', 'My::Other::Trait' ];
535 These traits will be applied to the caller's metaclass
536 instance. Providing traits for an exporting class that does not create
537 a metaclass for the caller is an error.
541 Dave Rolsky E<lt>autarch@urth.orgE<gt>
543 This is largely a reworking of code in Moose.pm originally written by
544 Stevan Little and others.
546 =head1 COPYRIGHT AND LICENSE
548 Copyright 2009 by Infinity Interactive, Inc.
550 L<http://www.iinteractive.com>
552 This library is free software; you can redistribute it and/or modify
553 it under the same terms as Perl itself.