rt63818 bugfix for false 'also' circular ref error
[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
645 my $type = ( split /::/, ref $meta )[-1]
c245d69b 646 or Moose->throw_error(
e606ae5f 647 'Cannot determine metaclass type for trait application . Meta isa '
8fa582b1 648 . ref $meta );
e606ae5f 649
8fa582b1 650 my @resolved_traits = map {
651 ref $_
652 ? $_
653 : Moose::Util::resolve_metatrait_alias( $type => $_ )
654 } @$traits;
e606ae5f 655
656 return unless @resolved_traits;
657
f785aad8 658 my %args = ( for => $class );
659
660 if ( $meta->isa('Moose::Meta::Role') ) {
661 $args{role_metaroles} = { role => \@resolved_traits };
662 }
663 else {
664 $args{class_metaroles} = { class => \@resolved_traits };
665 }
666
667 Moose::Util::MetaRole::apply_metaroles(%args);
e606ae5f 668}
669
670sub _get_caller {
8fa582b1 671
e606ae5f 672 # 1 extra level because it's called by import so there's a layer
673 # of indirection
674 my $offset = 1;
675
676 return
677 ( ref $_[1] && defined $_[1]->{into} ) ? $_[1]->{into}
678 : ( ref $_[1] && defined $_[1]->{into_level} )
679 ? caller( $offset + $_[1]->{into_level} )
680 : caller($offset);
681}
682
683sub _make_unimport_sub {
684 shift;
685 my $exporting_package = shift;
686 my $exports = shift;
687 my $export_recorder = shift;
ce5ccc1a 688 my $is_reexport = shift;
450432c8 689 my $meta_lookup = shift;
e606ae5f 690
691 return sub {
692 my $caller = scalar caller();
693 Moose::Exporter->_remove_keywords(
694 $caller,
695 [ keys %{$exports} ],
696 $export_recorder,
8fa582b1 697 $is_reexport,
e606ae5f 698 );
699 };
700}
701
702sub _remove_keywords {
703 shift;
704 my $package = shift;
705 my $keywords = shift;
706 my $recorded_exports = shift;
ce5ccc1a 707 my $is_reexport = shift;
e606ae5f 708
709 no strict 'refs';
710
8fa582b1 711 foreach my $name ( @{$keywords} ) {
e606ae5f 712 if ( defined &{ $package . '::' . $name } ) {
713 my $sub = \&{ $package . '::' . $name };
714
715 # make sure it is from us
716 next unless $recorded_exports->{$sub};
717
8fa582b1 718 if ( $is_reexport->{$name} ) {
719 no strict 'refs';
720 next
721 unless _export_is_flagged(
722 \*{ join q{::} => $package, $name } );
723 }
724
e606ae5f 725 # and if it is from us, then undef the slot
726 delete ${ $package . '::' }{$name};
727 }
728 }
729}
730
19ac4f06 731# maintain this for now for backcompat
732# make sure to return a sub to install in the same circumstances as previously
733# but this functionality now happens at the end of ->import
95056a1e 734sub _make_init_meta {
735 shift;
4cfe8f30 736 my $class = shift;
737 my $args = shift;
450432c8 738 my $meta_lookup = shift;
95056a1e 739
f785aad8 740 my %old_style_roles;
906eabcd 741 for my $role (
742 map {"${_}_roles"}
f785aad8 743 qw(
744 metaclass
906eabcd 745 attribute_metaclass
746 method_metaclass
747 wrapped_method_metaclass
748 instance_metaclass
749 constructor_class
750 destructor_class
751 error_class
f785aad8 752 )
906eabcd 753 ) {
f785aad8 754 $old_style_roles{$role} = $args->{$role}
755 if exists $args->{$role};
95056a1e 756 }
757
758 my %base_class_roles;
906eabcd 759 %base_class_roles = ( roles => $args->{base_class_roles} )
95056a1e 760 if exists $args->{base_class_roles};
761
f785aad8 762 my %new_style_roles = map { $_ => $args->{$_} }
763 grep { exists $args->{$_} } qw( class_metaroles role_metaroles );
764
765 return unless %new_style_roles || %old_style_roles || %base_class_roles;
95056a1e 766
b7f393bb 767 return sub {
768 shift;
769 my %opts = @_;
770 $meta_lookup->($opts{for_class});
771 };
95056a1e 772}
773
e2fa092d 774sub import {
775 strict->import;
776 warnings->import;
777}
778
e606ae5f 7791;
780
ad46f524 781# ABSTRACT: make an import() and unimport() just like Moose.pm
e606ae5f 782
ad46f524 783__END__
e606ae5f 784
785=head1 SYNOPSIS
786
787 package MyApp::Moose;
788
e606ae5f 789 use Moose ();
790 use Moose::Exporter;
791
792 Moose::Exporter->setup_import_methods(
5ac14e89 793 with_meta => [ 'has_rw', 'sugar2' ],
794 as_is => [ 'sugar3', \&Some::Random::thing ],
795 also => 'Moose',
e606ae5f 796 );
797
82ad7804 798 sub has_rw {
5ac14e89 799 my ( $meta, $name, %options ) = @_;
800 $meta->add_attribute(
801 $name,
82ad7804 802 is => 'rw',
803 %options,
804 );
805 }
806
e606ae5f 807 # then later ...
808 package MyApp::User;
809
810 use MyApp::Moose;
811
812 has 'name';
6daad0b9 813 has_rw 'size';
e606ae5f 814 thing;
815
816 no MyApp::Moose;
817
818=head1 DESCRIPTION
819
fd7ab111 820This module encapsulates the exporting of sugar functions in a
de000acd 821C<Moose.pm>-like manner. It does this by building custom C<import> and
822C<unimport> methods for your module, based on a spec you provide.
e606ae5f 823
37e4fe95 824It also lets you "stack" Moose-alike modules so you can export Moose's sugar
825as well as your own, along with sugar from any random C<MooseX> module, as
826long as they all use C<Moose::Exporter>. This feature exists to let you bundle
827a set of MooseX modules into a policy module that developers can use directly
828instead of using Moose itself.
e606ae5f 829
10e0127a 830To simplify writing exporter modules, C<Moose::Exporter> also imports
831C<strict> and C<warnings> into your exporter module, as well as into
832modules that use it.
833
e606ae5f 834=head1 METHODS
835
836This module provides two public methods:
837
4b68e0de 838=over 4
839
840=item B<< Moose::Exporter->setup_import_methods(...) >>
e606ae5f 841
de000acd 842When you call this method, C<Moose::Exporter> builds custom C<import> and
843C<unimport> methods for your module. The C<import> method
37e4fe95 844will export the functions you specify, and can also re-export functions
de000acd 845exported by some other module (like C<Moose.pm>). If you pass any parameters
846for L<Moose::Util::MetaRole>, the C<import> method will also call
847C<Moose::Util::MetaRole::apply_metaroles> and
848C<Moose::Util::MetaRole::apply_base_class_roles> as needed, after making
849sure the metaclass is initialized.
e606ae5f 850
37e4fe95 851The C<unimport> method cleans the caller's namespace of all the exported
cee38bb4 852functions. This includes any functions you re-export from other
853packages. However, if the consumer of your package also imports those
854functions from the original package, they will I<not> be cleaned.
e606ae5f 855
95056a1e 856Note that if any of these methods already exist, they will not be
857overridden, you will have to use C<build_import_methods> to get the
858coderef that would be installed.
e606ae5f 859
860This method accepts the following parameters:
861
4b68e0de 862=over 8
e606ae5f 863
5ac14e89 864=item * with_meta => [ ... ]
e606ae5f 865
37e4fe95 866This list of function I<names only> will be wrapped and then exported. The
5ac14e89 867wrapper will pass the metaclass object for the caller as its first argument.
868
869Many sugar functions will need to use this metaclass object to do something to
870the calling package.
e606ae5f 871
872=item * as_is => [ ... ]
873
37e4fe95 874This list of function names or sub references will be exported as-is. You can
875identify a subroutine by reference, which is handy to re-export some other
876module's functions directly by reference (C<\&Some::Package::function>).
e606ae5f 877
37e4fe95 878If you do export some other package's function, this function will never be
879removed by the C<unimport> method. The reason for this is we cannot know if
880the caller I<also> explicitly imported the sub themselves, and therefore wants
881to keep it.
e05fb8ae 882
f88cfe7c 883=item * trait_aliases => [ ... ]
884
bcbb1f7b 885This is a list of package names which should have shortened aliases exported,
f88cfe7c 886similar to the functionality of L<aliased>. Each element in the list can be
887either a package name, in which case the export will be named as the last
888namespace component of the package, or an arrayref, whose first element is the
889package to alias to, and second element is the alias to export.
890
e606ae5f 891=item * also => $name or \@names
892
893This is a list of modules which contain functions that the caller
894wants to export. These modules must also use C<Moose::Exporter>. The
895most common use case will be to export the functions from C<Moose.pm>.
5ac14e89 896Functions specified by C<with_meta> or C<as_is> take precedence over
ae8817b6 897functions exported by modules specified by C<also>, so that a module
898can selectively override functions exported by another module.
e606ae5f 899
900C<Moose::Exporter> also makes sure all these functions get removed
901when C<unimport> is called.
902
1365431e 903=item * meta_lookup => sub { ... }
904
4f45bde8 905This is a function which will be called to provide the metaclass
906to be operated upon by the exporter. This is an advanced feature
1365431e 907intended for use by package generator modules in the vein of
4f45bde8 908L<MooseX::Role::Parameterized> in order to simplify reusing sugar
909from other modules that use C<Moose::Exporter>. This function is
910used, for example, to select the metaclass to bind to functions
911that are exported using the C<with_meta> option.
912
913This function will receive one parameter: the class name into which
914the sugar is being exported. The default implementation is:
915
916 sub { Class::MOP::class_of(shift) }
917
918Accordingly, this function is expected to return a metaclass.
1365431e 919
e606ae5f 920=back
921
f785aad8 922You can also provide parameters for C<Moose::Util::MetaRole::apply_metaroles>
923and C<Moose::Util::MetaRole::base_class_roles>. Specifically, valid parameters
15851b87 924are "class_metaroles", "role_metaroles", and "base_class_roles".
95056a1e 925
4b68e0de 926=item B<< Moose::Exporter->build_import_methods(...) >>
e606ae5f 927
de000acd 928Returns two code refs, one for C<import> and one for C<unimport>.
95056a1e 929
37e4fe95 930Accepts the additional C<install> option, which accepts an arrayref of method
de000acd 931names to install into your exporting package. The valid options are C<import>
932and C<unimport>. Calling C<setup_import_methods> is equivalent
933to calling C<build_import_methods> with C<< install => [qw(import unimport)] >>
934except that it doesn't also return the methods.
e606ae5f 935
4df96f52 936The C<import> method is built using L<Sub::Exporter>. This means that it can
937take a hashref of the form C<< { into => $package } >> to specify the package
b360ed32 938it operates on.
939
e606ae5f 940Used by C<setup_import_methods>.
941
4b68e0de 942=back
943
e606ae5f 944=head1 IMPORTING AND init_meta
945
37e4fe95 946If you want to set an alternative base object class or metaclass class, see
947above for details on how this module can call L<Moose::Util::MetaRole> for
948you.
949
950If you want to do something that is not supported by this module, simply
951define an C<init_meta> method in your class. The C<import> method that
952C<Moose::Exporter> generates for you will call this method (if it exists). It
953will always pass the caller to this method via the C<for_class> parameter.
e606ae5f 954
955Most of the time, your C<init_meta> method will probably just call C<<
956Moose->init_meta >> to do the real work:
957
958 sub init_meta {
959 shift; # our class name
960 return Moose->init_meta( @_, metaclass => 'My::Metaclass' );
961 }
962
963=head1 METACLASS TRAITS
964
965The C<import> method generated by C<Moose::Exporter> will allow the
966user of your module to specify metaclass traits in a C<-traits>
967parameter passed as part of the import:
968
969 use Moose -traits => 'My::Meta::Trait';
970
971 use Moose -traits => [ 'My::Meta::Trait', 'My::Other::Trait' ];
972
973These traits will be applied to the caller's metaclass
974instance. Providing traits for an exporting class that does not create
975a metaclass for the caller is an error.
976
c5fc2c21 977=head1 BUGS
978
979See L<Moose/BUGS> for details on reporting bugs.
980
e606ae5f 981=cut