Fix perigrin's spelling
[gitmo/Moose.git] / lib / Moose / Exporter.pm
CommitLineData
e606ae5f 1package Moose::Exporter;
2
3use strict;
4use warnings;
5
b5ae7c00 6use Class::Load qw(is_class_loaded);
e606ae5f 7use Class::MOP;
8use List::MoreUtils qw( first_index uniq );
9use Moose::Util::MetaRole;
f88cfe7c 10use Scalar::Util qw(reftype);
091ac4b7 11use Sub::Exporter 0.980;
9f2230e9 12use Sub::Name qw(subname);
e606ae5f 13
14my %EXPORT_SPEC;
15
16sub setup_import_methods {
17 my ( $class, %args ) = @_;
18
2a591aa7 19 $args{exporting_package} ||= caller();
e606ae5f 20
95056a1e 21 $class->build_import_methods(
22 %args,
23 install => [qw(import unimport init_meta)]
24 );
e606ae5f 25}
26
5116baeb 27# A reminder to intrepid Moose hackers
fe49e9e9 28# there may be more than one level of exporter
29# don't make doy cry. -- perigrin
30
e606ae5f 31sub build_import_methods {
32 my ( $class, %args ) = @_;
33
34 my $exporting_package = $args{exporting_package} ||= caller();
35
450432c8 36 my $meta_lookup = $args{meta_lookup} || sub { Class::MOP::class_of(shift) };
4cfe8f30 37
e606ae5f 38 $EXPORT_SPEC{$exporting_package} = \%args;
39
8fa582b1 40 my @exports_from = $class->_follow_also($exporting_package);
e606ae5f 41
42 my $export_recorder = {};
8fa582b1 43 my $is_reexport = {};
e606ae5f 44
e0d3eb10 45 my $exports = $class->_make_sub_exporter_params(
ef487af7 46 [ $exporting_package, @exports_from ],
8fa582b1 47 $export_recorder,
48 $is_reexport,
ef487af7 49 $args{meta_lookup}, # so that we don't pass through the default
e0d3eb10 50 );
e606ae5f 51
4cfe8f30 52 my $exporter = $class->_make_exporter(
53 $exports,
54 $is_reexport,
450432c8 55 $meta_lookup,
4cfe8f30 56 );
e606ae5f 57
95056a1e 58 my %methods;
8fa582b1 59 $methods{import} = $class->_make_import_sub(
60 $exporting_package,
61 $exporter,
62 \@exports_from,
4cfe8f30 63 $is_reexport,
450432c8 64 $meta_lookup,
8fa582b1 65 );
e606ae5f 66
8fa582b1 67 $methods{unimport} = $class->_make_unimport_sub(
68 $exporting_package,
69 $exports,
70 $export_recorder,
4cfe8f30 71 $is_reexport,
450432c8 72 $meta_lookup,
8fa582b1 73 );
95056a1e 74
8fa582b1 75 $methods{init_meta} = $class->_make_init_meta(
76 $exporting_package,
4cfe8f30 77 \%args,
450432c8 78 $meta_lookup,
8fa582b1 79 );
95056a1e 80
81 my $package = Class::MOP::Package->initialize($exporting_package);
906eabcd 82 for my $to_install ( @{ $args{install} || [] } ) {
95056a1e 83 my $symbol = '&' . $to_install;
906eabcd 84 next
85 unless $methods{$to_install}
86 && !$package->has_package_symbol($symbol);
87 $package->add_package_symbol( $symbol, $methods{$to_install} );
95056a1e 88 }
e606ae5f 89
8fa582b1 90 return ( $methods{import}, $methods{unimport}, $methods{init_meta} );
e606ae5f 91}
92
d004fa18 93sub _make_exporter {
450432c8 94 my ($class, $exports, $is_reexport, $meta_lookup) = @_;
d004fa18 95
96 return Sub::Exporter::build_exporter(
97 {
98 exports => $exports,
99 groups => { default => [':all'] },
100 installer => sub {
101 my ($arg, $to_export) = @_;
450432c8 102 my $meta = $meta_lookup->($arg->{into});
d004fa18 103
104 goto &Sub::Exporter::default_installer unless $meta;
105
106 # don't overwrite existing symbols with our magically flagged
107 # version of it if we would install the same sub that's already
108 # in the importer
109
110 my @filtered_to_export;
111 my %installed;
112 for (my $i = 0; $i < @{ $to_export }; $i += 2) {
113 my ($as, $cv) = @{ $to_export }[$i, $i + 1];
114
115 next if !ref($as)
116 && $meta->has_package_symbol('&' . $as)
117 && $meta->get_package_symbol('&' . $as) == $cv;
118
119 push @filtered_to_export, $as, $cv;
120 $installed{$as} = 1 unless ref $as;
121 }
122
123 Sub::Exporter::default_installer($arg, \@filtered_to_export);
124
125 for my $name ( keys %{$is_reexport} ) {
126 no strict 'refs';
127 no warnings 'once';
128 next unless exists $installed{$name};
129 _flag_as_reexport( \*{ join q{::}, $arg->{into}, $name } );
130 }
131 },
132 }
133 );
134}
135
e606ae5f 136{
137 my $seen = {};
138
139 sub _follow_also {
140 my $class = shift;
141 my $exporting_package = shift;
142
143 local %$seen = ( $exporting_package => 1 );
144
ef487af7 145 return uniq( _follow_also_real($exporting_package) );
e606ae5f 146 }
147
148 sub _follow_also_real {
149 my $exporting_package = shift;
150
8fa582b1 151 if ( !exists $EXPORT_SPEC{$exporting_package} ) {
b5ae7c00 152 my $loaded = is_class_loaded($exporting_package);
ba1a3c2f 153
154 die "Package in also ($exporting_package) does not seem to "
8fa582b1 155 . "use Moose::Exporter"
156 . ( $loaded ? "" : " (is it loaded?)" );
ba1a3c2f 157 }
e606ae5f 158
159 my $also = $EXPORT_SPEC{$exporting_package}{also};
160
161 return unless defined $also;
162
163 my @also = ref $also ? @{$also} : $also;
164
8fa582b1 165 for my $package (@also) {
166 die
167 "Circular reference in 'also' parameter to Moose::Exporter between $exporting_package and $package"
e606ae5f 168 if $seen->{$package};
169
170 $seen->{$package} = 1;
171 }
172
173 return @also, map { _follow_also_real($_) } @also;
174 }
175}
176
f88cfe7c 177sub _parse_trait_aliases {
178 my $class = shift;
179 my ($package, $aliases) = @_;
180
181 my @ret;
182 for my $alias (@$aliases) {
183 my $name;
184 if (ref($alias)) {
185 reftype($alias) eq 'ARRAY'
186 or Moose->throw_error(reftype($alias) . " references are not "
187 . "valid arguments to the 'trait_aliases' "
188 . "option");
189
190 ($alias, $name) = @$alias;
191 }
192 else {
193 ($name = $alias) =~ s/.*:://;
194 }
195 push @ret, subname "${package}::${name}" => sub () { $alias };
196 }
197
198 return @ret;
199}
200
e606ae5f 201sub _make_sub_exporter_params {
ef487af7 202 my $class = shift;
203 my $packages = shift;
204 my $export_recorder = shift;
205 my $is_reexport = shift;
206 my $meta_lookup_override = shift;
e606ae5f 207
208 my %exports;
ef487af7 209 my $current_meta_lookup;
e606ae5f 210
211 for my $package ( @{$packages} ) {
212 my $args = $EXPORT_SPEC{$package}
213 or die "The $package package does not use Moose::Exporter\n";
214
ef487af7 215 $current_meta_lookup = $meta_lookup_override || $args->{meta_lookup};
216 $meta_lookup_override = $current_meta_lookup;
217
218 my $meta_lookup = $current_meta_lookup
219 || sub { Class::MOP::class_of(shift) };
220
5ac14e89 221 for my $name ( @{ $args->{with_meta} } ) {
0dd4228e 222 my $sub = $class->_sub_from_package( $package, $name )
223 or next;
e6a5040f 224
e606ae5f 225 my $fq_name = $package . '::' . $name;
226
5ac14e89 227 $exports{$name} = $class->_make_wrapped_sub_with_meta(
e606ae5f 228 $fq_name,
229 $sub,
230 $export_recorder,
450432c8 231 $meta_lookup,
ef487af7 232 ) unless exists $exports{$name};
e606ae5f 233 }
234
5ac14e89 235 for my $name ( @{ $args->{with_caller} } ) {
0dd4228e 236 my $sub = $class->_sub_from_package( $package, $name )
237 or next;
e6a5040f 238
45975bce 239 my $fq_name = $package . '::' . $name;
240
5ac14e89 241 $exports{$name} = $class->_make_wrapped_sub(
45975bce 242 $fq_name,
243 $sub,
244 $export_recorder,
ef487af7 245 ) unless exists $exports{$name};
45975bce 246 }
247
f88cfe7c 248 my @extra_exports = $class->_parse_trait_aliases(
249 $package, $args->{trait_aliases},
250 );
251 for my $name ( @{ $args->{as_is} }, @extra_exports ) {
8fa582b1 252 my ( $sub, $coderef_name );
e606ae5f 253
254 if ( ref $name ) {
e0d3eb10 255 $sub = $name;
e05fb8ae 256
e05fb8ae 257 my $coderef_pkg;
e6a5040f 258 ( $coderef_pkg, $coderef_name )
259 = Class::MOP::get_code_info($name);
e05fb8ae 260
e0d3eb10 261 if ( $coderef_pkg ne $package ) {
8fa582b1 262 $is_reexport->{$coderef_name} = 1;
e0d3eb10 263 }
e606ae5f 264 }
265 else {
0dd4228e 266 $sub = $class->_sub_from_package( $package, $name )
267 or next;
e6a5040f 268
e6a5040f 269 $coderef_name = $name;
e606ae5f 270 }
271
272 $export_recorder->{$sub} = 1;
273
ef487af7 274 $exports{$coderef_name} = sub { $sub }
275 unless exists $exports{$coderef_name};
e606ae5f 276 }
277 }
278
e0d3eb10 279 return \%exports;
e606ae5f 280}
281
0dd4228e 282sub _sub_from_package {
8fa582b1 283 my $sclass = shift;
0dd4228e 284 my $package = shift;
8fa582b1 285 my $name = shift;
0dd4228e 286
287 my $sub = do {
288 no strict 'refs';
289 \&{ $package . '::' . $name };
290 };
291
292 return $sub if defined &$sub;
293
8fa582b1 294 Carp::cluck "Trying to export undefined sub ${package}::${name}";
0dd4228e 295
296 return;
297}
298
96bb13ea 299our $CALLER;
300
301sub _make_wrapped_sub {
b4f00a34 302 my $self = shift;
96bb13ea 303 my $fq_name = shift;
304 my $sub = shift;
305 my $export_recorder = shift;
306
307 # We need to set the package at import time, so that when
308 # package Foo imports has(), we capture "Foo" as the
309 # package. This lets other packages call Foo::has() and get
310 # the right package. This is done for backwards compatibility
311 # with existing production code, not because this is a good
312 # idea ;)
313 return sub {
314 my $caller = $CALLER;
315
8fa582b1 316 my $wrapper = $self->_curry_wrapper( $sub, $fq_name, $caller );
b4f00a34 317
8fa582b1 318 my $sub = subname( $fq_name => $wrapper );
96bb13ea 319
320 $export_recorder->{$sub} = 1;
321
322 return $sub;
323 };
324}
e606ae5f 325
45975bce 326sub _make_wrapped_sub_with_meta {
327 my $self = shift;
328 my $fq_name = shift;
329 my $sub = shift;
330 my $export_recorder = shift;
450432c8 331 my $meta_lookup = shift;
45975bce 332
333 return sub {
334 my $caller = $CALLER;
335
8fa582b1 336 my $wrapper = $self->_late_curry_wrapper(
337 $sub, $fq_name,
450432c8 338 $meta_lookup => $caller
8fa582b1 339 );
45975bce 340
8fa582b1 341 my $sub = subname( $fq_name => $wrapper );
45975bce 342
343 $export_recorder->{$sub} = 1;
344
345 return $sub;
346 };
347}
348
6de00734 349sub _curry_wrapper {
badbc528 350 my $class = shift;
b4f00a34 351 my $sub = shift;
352 my $fq_name = shift;
6de00734 353 my @extra = @_;
b4f00a34 354
8fa582b1 355 my $wrapper = sub { $sub->( @extra, @_ ) };
356 if ( my $proto = prototype $sub ) {
357
2d7e979b 358 # XXX - Perl's prototype sucks. Use & to make set_prototype
6de00734 359 # ignore the fact that we're passing "private variables"
8fa582b1 360 &Scalar::Util::set_prototype( $wrapper, $proto );
badbc528 361 }
362 return $wrapper;
b4f00a34 363}
364
45975bce 365sub _late_curry_wrapper {
366 my $class = shift;
367 my $sub = shift;
368 my $fq_name = shift;
369 my $extra = shift;
370 my @ex_args = @_;
371
372 my $wrapper = sub {
8fa582b1 373
45975bce 374 # resolve curried arguments at runtime via this closure
8fa582b1 375 my @curry = ( $extra->(@ex_args) );
376 return $sub->( @curry, @_ );
45975bce 377 };
378
8fa582b1 379 if ( my $proto = prototype $sub ) {
380
45975bce 381 # XXX - Perl's prototype sucks. Use & to make set_prototype
382 # ignore the fact that we're passing "private variables"
8fa582b1 383 &Scalar::Util::set_prototype( $wrapper, $proto );
45975bce 384 }
385 return $wrapper;
386}
387
96bb13ea 388sub _make_import_sub {
389 shift;
390 my $exporting_package = shift;
391 my $exporter = shift;
392 my $exports_from = shift;
ce5ccc1a 393 my $is_reexport = shift;
450432c8 394 my $meta_lookup = shift;
96bb13ea 395
396 return sub {
397
398 # I think we could use Sub::Exporter's collector feature
399 # to do this, but that would be rather gross, since that
400 # feature isn't really designed to return a value to the
401 # caller of the exporter sub.
402 #
403 # Also, this makes sure we preserve backwards compat for
404 # _get_caller, so it always sees the arguments in the
405 # expected order.
406 my $traits;
407 ( $traits, @_ ) = _strip_traits(@_);
408
8f30b86e 409 my $metaclass;
410 ( $metaclass, @_ ) = _strip_metaclass(@_);
8fa582b1 411 $metaclass
412 = Moose::Util::resolve_metaclass_alias( 'Class' => $metaclass )
413 if defined $metaclass && length $metaclass;
8f30b86e 414
2937ed18 415 my $meta_name;
416 ( $meta_name, @_ ) = _strip_meta_name(@_);
d65bfd76 417
96bb13ea 418 # Normally we could look at $_[0], but in some weird cases
419 # (involving goto &Moose::import), $_[0] ends as something
420 # else (like Squirrel).
421 my $class = $exporting_package;
422
423 $CALLER = _get_caller(@_);
424
425 # this works because both pragmas set $^H (see perldoc
426 # perlvar) which affects the current compilation -
427 # i.e. the file who use'd us - which is why we don't need
428 # to do anything special to make it affect that file
429 # rather than this one (which is already compiled)
430
431 strict->import;
432 warnings->import;
433
96bb13ea 434 my $did_init_meta;
ef487af7 435 for my $c ( grep { $_->can('init_meta') } $class, @{$exports_from} ) {
8fa582b1 436
816208bc 437 # init_meta can apply a role, which when loaded uses
438 # Moose::Exporter, which in turn sets $CALLER, so we need
439 # to protect against that.
fdeb8354 440 local $CALLER = $CALLER;
d65bfd76 441 $c->init_meta(
442 for_class => $CALLER,
443 metaclass => $metaclass,
2937ed18 444 meta_name => $meta_name,
d65bfd76 445 );
96bb13ea 446 $did_init_meta = 1;
447 }
e606ae5f 448
19ac4f06 449 {
450 # The metaroles will use Moose::Role, which in turn uses
451 # Moose::Exporter, which in turn sets $CALLER, so we need
452 # to protect against that.
453 local $CALLER = $CALLER;
454 _apply_metaroles(
455 $CALLER,
456 [$class, @$exports_from],
457 $meta_lookup
458 );
459 }
460
96bb13ea 461 if ( $did_init_meta && @{$traits} ) {
8fa582b1 462
96bb13ea 463 # The traits will use Moose::Role, which in turn uses
464 # Moose::Exporter, which in turn sets $CALLER, so we need
465 # to protect against that.
466 local $CALLER = $CALLER;
450432c8 467 _apply_meta_traits( $CALLER, $traits, $meta_lookup );
96bb13ea 468 }
469 elsif ( @{$traits} ) {
70ea9161 470 require Moose;
96bb13ea 471 Moose->throw_error(
472 "Cannot provide traits when $class does not have an init_meta() method"
473 );
474 }
e606ae5f 475
8fa582b1 476 my ( undef, @args ) = @_;
477 my $extra = shift @args if ref $args[0] eq 'HASH';
478
479 $extra ||= {};
480 if ( !$extra->{into} ) {
481 $extra->{into_level} ||= 0;
482 $extra->{into_level}++;
483 }
484
485 $class->$exporter( $extra, @args );
96bb13ea 486 };
e606ae5f 487}
488
489sub _strip_traits {
1c3304e6 490 my $idx = first_index { ( $_ || '' ) eq '-traits' } @_;
e606ae5f 491
492 return ( [], @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
493
494 my $traits = $_[ $idx + 1 ];
495
496 splice @_, $idx, 2;
497
8fa582b1 498 $traits = [$traits] unless ref $traits;
e606ae5f 499
500 return ( $traits, @_ );
501}
502
8f30b86e 503sub _strip_metaclass {
1c3304e6 504 my $idx = first_index { ( $_ || '' ) eq '-metaclass' } @_;
8f30b86e 505
506 return ( undef, @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
507
508 my $metaclass = $_[ $idx + 1 ];
509
510 splice @_, $idx, 2;
511
512 return ( $metaclass, @_ );
513}
514
2937ed18 515sub _strip_meta_name {
1c3304e6 516 my $idx = first_index { ( $_ || '' ) eq '-meta_name' } @_;
d65bfd76 517
2937ed18 518 return ( 'meta', @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
d65bfd76 519
2937ed18 520 my $meta_name = $_[ $idx + 1 ];
d65bfd76 521
522 splice @_, $idx, 2;
523
2937ed18 524 return ( $meta_name, @_ );
d65bfd76 525}
526
19ac4f06 527sub _apply_metaroles {
528 my ($class, $exports_from, $meta_lookup) = @_;
529
530 my $metaroles = _collect_metaroles($exports_from);
531 my $base_class_roles = delete $metaroles->{base_class_roles};
532
533 my $meta = $meta_lookup->($class);
534 # for instance, Moose.pm uses Moose::Util::TypeConstraints
535 return unless $meta;
536
537 Moose::Util::MetaRole::apply_metaroles(
538 for => $meta,
539 %$metaroles,
540 ) if keys %$metaroles;
541
542 Moose::Util::MetaRole::apply_base_class_roles(
543 for => $meta,
544 roles => $base_class_roles,
545 ) if $meta->isa('Class::MOP::Class')
546 && $base_class_roles && @$base_class_roles;
547}
548
549sub _collect_metaroles {
550 my ($exports_from) = @_;
551
552 my @old_style_role_types = map { "${_}_roles" } qw(
553 metaclass
554 attribute_metaclass
555 method_metaclass
556 wrapped_method_metaclass
557 instance_metaclass
558 constructor_class
559 destructor_class
560 error_class
561 );
562
563 my %class_metaroles;
564 my %role_metaroles;
565 my @base_class_roles;
566 my %old_style_roles;
567
568 for my $exporter (@$exports_from) {
569 my $data = $EXPORT_SPEC{$exporter};
570
571 if (exists $data->{class_metaroles}) {
572 for my $type (keys %{ $data->{class_metaroles} }) {
573 push @{ $class_metaroles{$type} ||= [] },
574 @{ $data->{class_metaroles}{$type} };
575 }
576 }
577
578 if (exists $data->{role_metaroles}) {
579 for my $type (keys %{ $data->{role_metaroles} }) {
580 push @{ $role_metaroles{$type} ||= [] },
581 @{ $data->{role_metaroles}{$type} };
582 }
583 }
584
585 if (exists $data->{base_class_roles}) {
586 push @base_class_roles, @{ $data->{base_class_roles} };
587 }
588
589 for my $type (@old_style_role_types) {
590 if (exists $data->{$type}) {
591 push @{ $old_style_roles{$type} ||= [] },
592 @{ $data->{$type} };
593 }
594 }
595 }
596
597 return {
598 (keys(%class_metaroles)
599 ? (class_metaroles => \%class_metaroles)
600 : ()),
601 (keys(%role_metaroles)
602 ? (role_metaroles => \%role_metaroles)
603 : ()),
604 (@base_class_roles
605 ? (base_class_roles => \@base_class_roles)
606 : ()),
607 %old_style_roles,
608 };
609}
610
e606ae5f 611sub _apply_meta_traits {
450432c8 612 my ( $class, $traits, $meta_lookup ) = @_;
e606ae5f 613
614 return unless @{$traits};
615
450432c8 616 my $meta = $meta_lookup->($class);
e606ae5f 617
618 my $type = ( split /::/, ref $meta )[-1]
c245d69b 619 or Moose->throw_error(
e606ae5f 620 'Cannot determine metaclass type for trait application . Meta isa '
8fa582b1 621 . ref $meta );
e606ae5f 622
8fa582b1 623 my @resolved_traits = map {
624 ref $_
625 ? $_
626 : Moose::Util::resolve_metatrait_alias( $type => $_ )
627 } @$traits;
e606ae5f 628
629 return unless @resolved_traits;
630
f785aad8 631 my %args = ( for => $class );
632
633 if ( $meta->isa('Moose::Meta::Role') ) {
634 $args{role_metaroles} = { role => \@resolved_traits };
635 }
636 else {
637 $args{class_metaroles} = { class => \@resolved_traits };
638 }
639
640 Moose::Util::MetaRole::apply_metaroles(%args);
e606ae5f 641}
642
643sub _get_caller {
8fa582b1 644
e606ae5f 645 # 1 extra level because it's called by import so there's a layer
646 # of indirection
647 my $offset = 1;
648
649 return
650 ( ref $_[1] && defined $_[1]->{into} ) ? $_[1]->{into}
651 : ( ref $_[1] && defined $_[1]->{into_level} )
652 ? caller( $offset + $_[1]->{into_level} )
653 : caller($offset);
654}
655
656sub _make_unimport_sub {
657 shift;
658 my $exporting_package = shift;
659 my $exports = shift;
660 my $export_recorder = shift;
ce5ccc1a 661 my $is_reexport = shift;
450432c8 662 my $meta_lookup = shift;
e606ae5f 663
664 return sub {
665 my $caller = scalar caller();
666 Moose::Exporter->_remove_keywords(
667 $caller,
668 [ keys %{$exports} ],
669 $export_recorder,
8fa582b1 670 $is_reexport,
e606ae5f 671 );
672 };
673}
674
675sub _remove_keywords {
676 shift;
677 my $package = shift;
678 my $keywords = shift;
679 my $recorded_exports = shift;
ce5ccc1a 680 my $is_reexport = shift;
e606ae5f 681
682 no strict 'refs';
683
8fa582b1 684 foreach my $name ( @{$keywords} ) {
e606ae5f 685 if ( defined &{ $package . '::' . $name } ) {
686 my $sub = \&{ $package . '::' . $name };
687
688 # make sure it is from us
689 next unless $recorded_exports->{$sub};
690
8fa582b1 691 if ( $is_reexport->{$name} ) {
692 no strict 'refs';
693 next
694 unless _export_is_flagged(
695 \*{ join q{::} => $package, $name } );
696 }
697
e606ae5f 698 # and if it is from us, then undef the slot
699 delete ${ $package . '::' }{$name};
700 }
701 }
702}
703
19ac4f06 704# maintain this for now for backcompat
705# make sure to return a sub to install in the same circumstances as previously
706# but this functionality now happens at the end of ->import
95056a1e 707sub _make_init_meta {
708 shift;
4cfe8f30 709 my $class = shift;
710 my $args = shift;
450432c8 711 my $meta_lookup = shift;
95056a1e 712
f785aad8 713 my %old_style_roles;
906eabcd 714 for my $role (
715 map {"${_}_roles"}
f785aad8 716 qw(
717 metaclass
906eabcd 718 attribute_metaclass
719 method_metaclass
720 wrapped_method_metaclass
721 instance_metaclass
722 constructor_class
723 destructor_class
724 error_class
f785aad8 725 )
906eabcd 726 ) {
f785aad8 727 $old_style_roles{$role} = $args->{$role}
728 if exists $args->{$role};
95056a1e 729 }
730
731 my %base_class_roles;
906eabcd 732 %base_class_roles = ( roles => $args->{base_class_roles} )
95056a1e 733 if exists $args->{base_class_roles};
734
f785aad8 735 my %new_style_roles = map { $_ => $args->{$_} }
736 grep { exists $args->{$_} } qw( class_metaroles role_metaroles );
737
738 return unless %new_style_roles || %old_style_roles || %base_class_roles;
95056a1e 739
19ac4f06 740 return sub { };
95056a1e 741}
742
e2fa092d 743sub import {
744 strict->import;
745 warnings->import;
746}
747
e606ae5f 7481;
749
ad46f524 750# ABSTRACT: make an import() and unimport() just like Moose.pm
e606ae5f 751
ad46f524 752__END__
e606ae5f 753
754=head1 SYNOPSIS
755
756 package MyApp::Moose;
757
e606ae5f 758 use Moose ();
759 use Moose::Exporter;
760
761 Moose::Exporter->setup_import_methods(
5ac14e89 762 with_meta => [ 'has_rw', 'sugar2' ],
763 as_is => [ 'sugar3', \&Some::Random::thing ],
764 also => 'Moose',
e606ae5f 765 );
766
82ad7804 767 sub has_rw {
5ac14e89 768 my ( $meta, $name, %options ) = @_;
769 $meta->add_attribute(
770 $name,
82ad7804 771 is => 'rw',
772 %options,
773 );
774 }
775
e606ae5f 776 # then later ...
777 package MyApp::User;
778
779 use MyApp::Moose;
780
781 has 'name';
6daad0b9 782 has_rw 'size';
e606ae5f 783 thing;
784
785 no MyApp::Moose;
786
787=head1 DESCRIPTION
788
fd7ab111 789This module encapsulates the exporting of sugar functions in a
de000acd 790C<Moose.pm>-like manner. It does this by building custom C<import> and
791C<unimport> methods for your module, based on a spec you provide.
e606ae5f 792
37e4fe95 793It also lets you "stack" Moose-alike modules so you can export Moose's sugar
794as well as your own, along with sugar from any random C<MooseX> module, as
795long as they all use C<Moose::Exporter>. This feature exists to let you bundle
796a set of MooseX modules into a policy module that developers can use directly
797instead of using Moose itself.
e606ae5f 798
10e0127a 799To simplify writing exporter modules, C<Moose::Exporter> also imports
800C<strict> and C<warnings> into your exporter module, as well as into
801modules that use it.
802
e606ae5f 803=head1 METHODS
804
805This module provides two public methods:
806
4b68e0de 807=over 4
808
809=item B<< Moose::Exporter->setup_import_methods(...) >>
e606ae5f 810
de000acd 811When you call this method, C<Moose::Exporter> builds custom C<import> and
812C<unimport> methods for your module. The C<import> method
37e4fe95 813will export the functions you specify, and can also re-export functions
de000acd 814exported by some other module (like C<Moose.pm>). If you pass any parameters
815for L<Moose::Util::MetaRole>, the C<import> method will also call
816C<Moose::Util::MetaRole::apply_metaroles> and
817C<Moose::Util::MetaRole::apply_base_class_roles> as needed, after making
818sure the metaclass is initialized.
e606ae5f 819
37e4fe95 820The C<unimport> method cleans the caller's namespace of all the exported
cee38bb4 821functions. This includes any functions you re-export from other
822packages. However, if the consumer of your package also imports those
823functions from the original package, they will I<not> be cleaned.
e606ae5f 824
95056a1e 825Note that if any of these methods already exist, they will not be
826overridden, you will have to use C<build_import_methods> to get the
827coderef that would be installed.
e606ae5f 828
829This method accepts the following parameters:
830
4b68e0de 831=over 8
e606ae5f 832
5ac14e89 833=item * with_meta => [ ... ]
e606ae5f 834
37e4fe95 835This list of function I<names only> will be wrapped and then exported. The
5ac14e89 836wrapper will pass the metaclass object for the caller as its first argument.
837
838Many sugar functions will need to use this metaclass object to do something to
839the calling package.
e606ae5f 840
841=item * as_is => [ ... ]
842
37e4fe95 843This list of function names or sub references will be exported as-is. You can
844identify a subroutine by reference, which is handy to re-export some other
845module's functions directly by reference (C<\&Some::Package::function>).
e606ae5f 846
37e4fe95 847If you do export some other package's function, this function will never be
848removed by the C<unimport> method. The reason for this is we cannot know if
849the caller I<also> explicitly imported the sub themselves, and therefore wants
850to keep it.
e05fb8ae 851
f88cfe7c 852=item * trait_aliases => [ ... ]
853
bcbb1f7b 854This is a list of package names which should have shortened aliases exported,
f88cfe7c 855similar to the functionality of L<aliased>. Each element in the list can be
856either a package name, in which case the export will be named as the last
857namespace component of the package, or an arrayref, whose first element is the
858package to alias to, and second element is the alias to export.
859
e606ae5f 860=item * also => $name or \@names
861
862This is a list of modules which contain functions that the caller
863wants to export. These modules must also use C<Moose::Exporter>. The
864most common use case will be to export the functions from C<Moose.pm>.
5ac14e89 865Functions specified by C<with_meta> or C<as_is> take precedence over
ae8817b6 866functions exported by modules specified by C<also>, so that a module
867can selectively override functions exported by another module.
e606ae5f 868
869C<Moose::Exporter> also makes sure all these functions get removed
870when C<unimport> is called.
871
1365431e 872=item * meta_lookup => sub { ... }
873
4f45bde8 874This is a function which will be called to provide the metaclass
875to be operated upon by the exporter. This is an advanced feature
1365431e 876intended for use by package generator modules in the vein of
4f45bde8 877L<MooseX::Role::Parameterized> in order to simplify reusing sugar
878from other modules that use C<Moose::Exporter>. This function is
879used, for example, to select the metaclass to bind to functions
880that are exported using the C<with_meta> option.
881
882This function will receive one parameter: the class name into which
883the sugar is being exported. The default implementation is:
884
885 sub { Class::MOP::class_of(shift) }
886
887Accordingly, this function is expected to return a metaclass.
1365431e 888
e606ae5f 889=back
890
f785aad8 891You can also provide parameters for C<Moose::Util::MetaRole::apply_metaroles>
892and C<Moose::Util::MetaRole::base_class_roles>. Specifically, valid parameters
15851b87 893are "class_metaroles", "role_metaroles", and "base_class_roles".
95056a1e 894
4b68e0de 895=item B<< Moose::Exporter->build_import_methods(...) >>
e606ae5f 896
de000acd 897Returns two code refs, one for C<import> and one for C<unimport>.
95056a1e 898
37e4fe95 899Accepts the additional C<install> option, which accepts an arrayref of method
de000acd 900names to install into your exporting package. The valid options are C<import>
901and C<unimport>. Calling C<setup_import_methods> is equivalent
902to calling C<build_import_methods> with C<< install => [qw(import unimport)] >>
903except that it doesn't also return the methods.
e606ae5f 904
4df96f52 905The C<import> method is built using L<Sub::Exporter>. This means that it can
906take a hashref of the form C<< { into => $package } >> to specify the package
b360ed32 907it operates on.
908
e606ae5f 909Used by C<setup_import_methods>.
910
4b68e0de 911=back
912
e606ae5f 913=head1 IMPORTING AND init_meta
914
37e4fe95 915If you want to set an alternative base object class or metaclass class, see
916above for details on how this module can call L<Moose::Util::MetaRole> for
917you.
918
919If you want to do something that is not supported by this module, simply
920define an C<init_meta> method in your class. The C<import> method that
921C<Moose::Exporter> generates for you will call this method (if it exists). It
922will always pass the caller to this method via the C<for_class> parameter.
e606ae5f 923
924Most of the time, your C<init_meta> method will probably just call C<<
925Moose->init_meta >> to do the real work:
926
927 sub init_meta {
928 shift; # our class name
929 return Moose->init_meta( @_, metaclass => 'My::Metaclass' );
930 }
931
932=head1 METACLASS TRAITS
933
934The C<import> method generated by C<Moose::Exporter> will allow the
935user of your module to specify metaclass traits in a C<-traits>
936parameter passed as part of the import:
937
938 use Moose -traits => 'My::Meta::Trait';
939
940 use Moose -traits => [ 'My::Meta::Trait', 'My::Other::Trait' ];
941
942These traits will be applied to the caller's metaclass
943instance. Providing traits for an exporting class that does not create
944a metaclass for the caller is an error.
945
c5fc2c21 946=head1 BUGS
947
948See L<Moose/BUGS> for details on reporting bugs.
949
e606ae5f 950=cut