Remove references to
[gitmo/Moose.git] / lib / Moose / Exporter.pm
CommitLineData
5bd4db9b 1package Moose::Exporter;
2
3use strict;
4use warnings;
5
5b5187e0 6use Carp qw( confess );
5bd4db9b 7use Class::MOP;
5b5187e0 8use List::MoreUtils qw( first_index uniq );
72d15b83 9use Moose::Util::MetaRole;
5bd4db9b 10use Sub::Exporter;
11
12
0338a411 13my %EXPORT_SPEC;
1a601f52 14
aedcb7d9 15sub setup_import_methods {
16 my ( $class, %args ) = @_;
17
18 my $exporting_package = $args{exporting_package} ||= caller();
19
75f99915 20 my ( $import, $unimport ) = $class->build_import_methods(%args);
aedcb7d9 21
22 no strict 'refs';
23 *{ $exporting_package . '::import' } = $import;
24 *{ $exporting_package . '::unimport' } = $unimport;
25}
26
a5c426fc 27sub build_import_methods {
aedcb7d9 28 my ( $class, %args ) = @_;
a5c426fc 29
aedcb7d9 30 my $exporting_package = $args{exporting_package} ||= caller();
a5c426fc 31
0338a411 32 $EXPORT_SPEC{$exporting_package} = \%args;
a5c426fc 33
4403da90 34 my @exports_from = $class->_follow_also( $exporting_package );
35
36 my $exports
89b29fce 37 = $class->_make_sub_exporter_params( $exporting_package, @exports_from );
f5324cca 38
39 my $exporter = Sub::Exporter::build_exporter(
40 {
41 exports => $exports,
42 groups => { default => [':all'] }
43 }
1a601f52 44 );
a5c426fc 45
23af33ae 46 # $args{_export_to_main} exists for backwards compat, because
47 # Moose::Util::TypeConstraints did export to main (unlike Moose &
48 # Moose::Role).
12fd2648 49 my $import = $class->_make_import_sub( $exporting_package, $exporter,
50 \@exports_from, $args{_export_to_main} );
a5c426fc 51
12fd2648 52 my $unimport
53 = $class->_make_unimport_sub( $exporting_package, \@exports_from,
54 [ keys %{$exports} ] );
a5c426fc 55
aedcb7d9 56 return ( $import, $unimport )
a5c426fc 57}
58
4403da90 59{
8df9ab64 60 my $seen = {};
5bd4db9b 61
4403da90 62 sub _follow_also {
63 my $class = shift;
64 my $exporting_package = shift;
5bd4db9b 65
8df9ab64 66 local %$seen = ( $exporting_package => 1 );
97a93056 67
4403da90 68 return uniq( _follow_also_real($exporting_package) );
97a93056 69 }
70
4403da90 71 sub _follow_also_real {
72 my $exporting_package = shift;
73
74 die "Package in also ($exporting_package) does not seem to use MooseX::Exporter"
75 unless exists $EXPORT_SPEC{$exporting_package};
76
77 my $also = $EXPORT_SPEC{$exporting_package}{also};
78
79 return unless defined $also;
80
81 my @also = ref $also ? @{$also} : $also;
82
83 for my $package (@also)
84 {
85 die "Circular reference in also parameter to MooseX::Exporter between $exporting_package and $package"
8df9ab64 86 if $seen->{$package};
97a93056 87
8df9ab64 88 $seen->{$package} = 1;
5bd4db9b 89 }
4403da90 90
91 return @also, map { _follow_also_real($_) } @also;
92 }
93}
94
89b29fce 95sub _make_sub_exporter_params {
4403da90 96 my $class = shift;
97 my @packages = @_;
98
99 my %exports;
100
101 for my $package (@packages) {
102 my $args = $EXPORT_SPEC{$package}
103 or die "The $package package does not use Moose::Exporter\n";
104
105 for my $name ( @{ $args->{with_caller} } ) {
106 my $sub = do {
e05b7c8e 107 no strict 'refs';
4403da90 108 \&{ $package . '::' . $name };
e05b7c8e 109 };
4403da90 110
111 $exports{$name} = $class->_make_wrapped_sub(
112 $package,
113 $name,
114 $sub
115 );
5bd4db9b 116 }
117
4403da90 118 for my $name ( @{ $args->{as_is} } ) {
119 my $sub;
120
121 if ( ref $name ) {
122 $sub = $name;
123 $name = ( Class::MOP::get_code_info($name) )[1];
124 }
125 else {
126 $sub = do {
127 no strict 'refs';
128 \&{ $package . '::' . $name };
129 };
130 }
131
132 $exports{$name} = sub {$sub};
133 }
5bd4db9b 134 }
135
f5324cca 136 return \%exports;
5bd4db9b 137}
138
e05b7c8e 139{
140 # This variable gets closed over in each export _generator_. Then
141 # in the generator we grab the value and close over it _again_ in
142 # the real export, so it gets captured each time the generator
143 # runs.
144 #
145 # In the meantime, we arrange for the import method we generate to
146 # set this variable to the caller each time it is called.
147 #
148 # This is all a bit confusing, but it works.
149 my $CALLER;
150
151 sub _make_wrapped_sub {
152 my $class = shift;
153 my $exporting_package = shift;
154 my $name = shift;
155 my $sub = shift;
1a601f52 156
e05b7c8e 157 # We need to set the package at import time, so that when
158 # package Foo imports has(), we capture "Foo" as the
159 # package. This lets other packages call Foo::has() and get
160 # the right package. This is done for backwards compatibility
161 # with existing production code, not because this is a good
162 # idea ;)
163 return sub {
164 my $caller = $CALLER;
165 Class::MOP::subname( $exporting_package . '::'
166 . $name => sub { $sub->( $caller, @_ ) } );
167 };
168 }
f5324cca 169
e05b7c8e 170 sub _make_import_sub {
42c391b1 171 shift;
12fd2648 172 my $exporting_package = shift;
173 my $exporter = shift;
174 my $exports_from = shift;
175 my $export_to_main = shift;
1a601f52 176
e05b7c8e 177 return sub {
5b5187e0 178 # I think we could use Sub::Exporter's collector feature
179 # to do this, but that would be rather gross, since that
180 # feature isn't really designed to return a value to the
181 # caller of the exporter sub.
182 #
183 # Also, this makes sure we preserve backwards compat for
184 # _get_caller, so it always sees the arguments in the
185 # expected order.
186 my $traits;
187 ($traits, @_) = Moose::Exporter::_strip_traits(@_);
1a601f52 188
12fd2648 189 # Normally we could look at $_[0], but in some weird cases
190 # (involving goto &Moose::import), $_[0] ends as something
191 # else (like Squirrel).
192 my $class = $exporting_package;
1a601f52 193
e05b7c8e 194 $CALLER = Moose::Exporter::_get_caller(@_);
1a601f52 195
e05b7c8e 196 # this works because both pragmas set $^H (see perldoc
197 # perlvar) which affects the current compilation -
198 # i.e. the file who use'd us - which is why we don't need
199 # to do anything special to make it affect that file
200 # rather than this one (which is already compiled)
201
202 strict->import;
203 warnings->import;
204
205 # we should never export to main
23af33ae 206 if ( $CALLER eq 'main' && ! $export_to_main ) {
e05b7c8e 207 warn
208 qq{$class does not export its sugar to the 'main' package.\n};
209 return;
210 }
1a601f52 211
5b5187e0 212 my $did_init_meta;
213 for my $c ( grep { $_->can('init_meta') } $class, @{$exports_from} ) {
42c391b1 214
215 $c->init_meta( for_class => $CALLER );
5b5187e0 216 $did_init_meta = 1;
e05b7c8e 217 }
218
72d15b83 219 if ( $did_init_meta && @{$traits} ) {
f9dfa78b 220 _apply_meta_traits( $CALLER, $traits );
221 }
72d15b83 222 elsif ( @{$traits} ) {
f9dfa78b 223 confess
224 "Cannot provide traits when $class does not have an init_meta() method";
225 }
5b5187e0 226
e05b7c8e 227 goto $exporter;
228 };
229 }
1a601f52 230}
231
5b5187e0 232sub _strip_traits {
233 my $idx = first_index { $_ eq '-traits' } @_;
234
72d15b83 235 return ( [], @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
5b5187e0 236
237 my $traits = $_[ $idx + 1 ];
238
239 splice @_, $idx, 2;
240
f9dfa78b 241 $traits = [ $traits ] unless ref $traits;
242
5b5187e0 243 return ( $traits, @_ );
244}
245
246sub _apply_meta_traits {
247 my ( $class, $traits ) = @_;
248
72d15b83 249 return unless @{$traits};
5b5187e0 250
251 my $meta = $class->meta();
252
253 my $type = ( split /::/, ref $meta )[-1]
254 or confess
255 'Cannot determine metaclass type for trait application . Meta isa '
256 . ref $meta;
257
72d15b83 258 my @resolved_traits
259 = map { Moose::Util::resolve_metatrait_alias( $type => $_ ) }
260 @$traits;
5b5187e0 261
72d15b83 262 return unless @resolved_traits;
5b5187e0 263
72d15b83 264 Moose::Util::MetaRole::apply_metaclass_roles(
265 for_class => $class,
266 metaclass_roles => \@resolved_traits,
267 );
5b5187e0 268}
269
1a601f52 270sub _get_caller {
271 # 1 extra level because it's called by import so there's a layer
272 # of indirection
273 my $offset = 1;
274
275 return
276 ( ref $_[1] && defined $_[1]->{into} ) ? $_[1]->{into}
277 : ( ref $_[1] && defined $_[1]->{into_level} )
278 ? caller( $offset + $_[1]->{into_level} )
279 : caller($offset);
280}
281
282sub _make_unimport_sub {
b30e7781 283 shift;
12fd2648 284 my $exporting_package = shift;
285 my $sources = shift;
286 my $keywords = shift;
1a601f52 287
1a601f52 288 return sub {
2c9c8797 289 my $caller = scalar caller();
b30e7781 290 Moose::Exporter->_remove_keywords(
291 $caller,
12fd2648 292 [ $exporting_package, @{$sources} ],
b30e7781 293 $keywords
294 );
1a601f52 295 };
296}
297
2c9c8797 298sub _remove_keywords {
299 shift;
300 my $package = shift;
b30e7781 301 my $sources = shift;
2c9c8797 302 my $keywords = shift;
303
b30e7781 304 my %sources = map { $_ => 1 } @{$sources};
305
2c9c8797 306 no strict 'refs';
307
308 # loop through the keywords ...
309 foreach my $name ( @{$keywords} ) {
310
311 # if we find one ...
312 if ( defined &{ $package . '::' . $name } ) {
313 my $keyword = \&{ $package . '::' . $name };
314
315 # make sure it is from us
316 my ($pkg_name) = Class::MOP::get_code_info($keyword);
b30e7781 317 next unless $sources{$pkg_name};
2c9c8797 318
319 # and if it is from us, then undef the slot
320 delete ${ $package . '::' }{$name};
321 }
322 }
323}
324
5bd4db9b 3251;
2f29843c 326
327__END__
328
329=head1 NAME
330
331Moose::Exporter - make an import() and unimport() just like Moose.pm
332
333=head1 SYNOPSIS
334
335 package MyApp::Moose;
336
337 use strict;
338 use warnings;
339
340 use Moose ();
341 use Moose::Exporter;
342
aedcb7d9 343 Moose::Exporter->setup_import_methods(
f8a5a70e 344 with_caller => [ 'sugar1', 'sugar2' ],
345 as_is => [ 'sugar3', \&Some::Random::thing ],
346 also => 'Moose',
2f29843c 347 );
348
349 # then later ...
350 package MyApp::User;
351
352 use MyApp::Moose;
353
354 has 'name';
355 sugar1 'do your thing';
356 thing;
357
358 no MyApp::Moose;
359
360=head1 DESCRIPTION
361
362This module encapsulates the logic to export sugar functions like
363C<Moose.pm>. It does this by building custom C<import> and C<unimport>
364methods for your module, based on a spec your provide.
365
366It also lets your "stack" Moose-alike modules so you can export
367Moose's sugar as well as your own, along with sugar from any random
368C<MooseX> module, as long as they all use C<Moose::Exporter>.
369
370=head1 METHODS
371
75f99915 372This module provides two public methods:
2f29843c 373
aedcb7d9 374=head2 Moose::Exporter->setup_import_methods(...)
2f29843c 375
376When you call this method, C<Moose::Exporter> build custom C<import>
377and C<unimport> methods for your module. The import method will export
378the functions you specify, and you can also tell it to export
379functions exported by some other module (like C<Moose.pm>).
380
381The C<unimport> method cleans the callers namespace of all the
382exported functions.
383
384This method accepts the following parameters:
385
386=over 4
387
97a93056 388=item * with_caller => [ ... ]
389
390This a list of function I<names only> to be exported wrapped and then
391exported. The wrapper will pass the name of the calling package as the
392first argument to the function. Many sugar functions need to know
393their caller so they can get the calling package's metaclass object.
394
395=item * as_is => [ ... ]
2f29843c 396
397This a list of function names or sub references to be exported
398as-is. You can identify a subroutine by reference, which is handy to
399re-export some other module's functions directly by reference
400(C<\&Some::Package::function>).
401
42ade269 402=item * also => $name or \@names
2f29843c 403
42ade269 404This is a list of modules which contain functions that the caller
405wants to export. These modules must also use C<Moose::Exporter>. The
406most common use case will be to export the functions from C<Moose.pm>.
407
408C<Moose::Exporter> also makes sure all these functions get removed
409when C<unimport> is called.
2f29843c 410
411=back
412
aedcb7d9 413=head2 Moose::Exporter->build_import_methods(...)
414
415Returns two code refs, one for import and one for unimport.
416
417Used by C<setup_import_methods>.
418
42ade269 419=head1 IMPORTING AND init_meta
420
421If you want to set an alternative base object class or metaclass
422class, simply define an C<init_meta> method in your class. The
423C<import> method that C<Moose::Exporter> generates for you will call
424this method (if it exists). It will always pass the caller to this
425method via the C<for_class> parameter.
426
427Most of the time, your C<init_meta> method will probably just call C<<
428Moose->init_meta >> to do the real work:
429
430 sub init_meta {
431 shift; # our class name
432 return Moose->init_meta( @_, metaclass => 'My::Metaclass' );
433 }
434
f9dfa78b 435=head1 METACLASS TRAITS
436
437The C<import> method generated by C<Moose::Exporter> will allow the
438user of your module to specify metaclass traits in a C<-traits>
439parameter passed as part of the import:
440
441 use Moose -traits => 'My::Meta::Trait';
442
443 use Moose -traits => [ 'My::Meta::Trait', 'My::Other::Trait' ];
444
631f7926 445These traits will be applied to the caller's metaclass
446instance. Providing traits for an exporting class that does not create
447a metaclass for the caller is an error.
f9dfa78b 448
2f29843c 449=head1 AUTHOR
450
451Dave Rolsky E<lt>autarch@urth.orgE<gt>
452
453This is largely a reworking of code in Moose.pm originally written by
454Stevan Little and others.
455
456=head1 COPYRIGHT AND LICENSE
457
458Copyright 2008 by Infinity Interactive, Inc.
459
460L<http://www.iinteractive.com>
461
462This library is free software; you can redistribute it and/or modify
463it under the same terms as Perl itself.
464
465=cut