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