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