lib/Moose/Exporter.pm

   1 package Moose::Exporter;
   2
   3 use strict;
   4 use warnings;
   5
   6 use Class::Load qw(is_class_loaded);
   7 use Class::MOP;
   8 use List::MoreUtils qw( first_index uniq );
   9 use Moose::Util::MetaRole;
  10 use Scalar::Util qw(reftype);
  11 use Sub::Exporter 0.980;
  12 use Sub::Name qw(subname);
  13
  14 my %EXPORT_SPEC;
  15
  16 sub setup_import_methods {
  17     my ( $class, %args ) = @_;
  18
  19     $args{exporting_package} ||= caller();
  20
  21     $class->build_import_methods(
  22         %args,
  23         install => [qw(import unimport init_meta)]
  24     );
  25 }
  26
  27 # A reminder to intrepid Moose hackers
  28 # there may be more than one level of exporter
  29 # don't make doy cry. -- perigrin
  30
  31 sub build_import_methods {
  32     my ( $class, %args ) = @_;
  33
  34     my $exporting_package = $args{exporting_package} ||= caller();
  35
  36     my $meta_lookup = $args{meta_lookup} || sub { Class::MOP::class_of(shift) };
  37
  38     $EXPORT_SPEC{$exporting_package} = \%args;
  39
  40     my @exports_from = $class->_follow_also($exporting_package);
  41
  42     my $export_recorder = {};
  43     my $is_reexport     = {};
  44
  45     my $exports = $class->_make_sub_exporter_params(
  46         [ $exporting_package, @exports_from ],
  47         $export_recorder,
  48         $is_reexport,
  49         $args{meta_lookup}, # so that we don't pass through the default
  50     );
  51
  52     my $exporter = $class->_make_exporter(
  53         $exports,
  54         $is_reexport,
  55         $meta_lookup,
  56     );
  57
  58     my %methods;
  59     $methods{import} = $class->_make_import_sub(
  60         $exporting_package,
  61         $exporter,
  62         \@exports_from,
  63         $is_reexport,
  64         $meta_lookup,
  65     );
  66
  67     $methods{unimport} = $class->_make_unimport_sub(
  68         $exporting_package,
  69         $exports,
  70         $export_recorder,
  71         $is_reexport,
  72         $meta_lookup,
  73     );
  74
  75     $methods{init_meta} = $class->_make_init_meta(
  76         $exporting_package,
  77         \%args,
  78         $meta_lookup,
  79     );
  80
  81     my $package = Class::MOP::Package->initialize($exporting_package);
  82     for my $to_install ( @{ $args{install} || [] } ) {
  83         my $symbol = '&' . $to_install;
  84         next
  85             unless $methods{$to_install}
  86                 && !$package->has_package_symbol($symbol);
  87         $package->add_package_symbol( $symbol, $methods{$to_install} );
  88     }
  89
  90     return ( $methods{import}, $methods{unimport}, $methods{init_meta} );
  91 }
  92
  93 sub _make_exporter {
  94     my ($class, $exports, $is_reexport, $meta_lookup) = @_;
  95
  96     return Sub::Exporter::build_exporter(
  97         {
  98             exports   => $exports,
  99             groups    => { default => [':all'] },
 100             installer => sub {
 101                 my ($arg, $to_export) = @_;
 102                 my $meta = $meta_lookup->($arg->{into});
 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
 136 sub _follow_also {
 137     my $class             = shift;
 138     my $exporting_package = shift;
 139
 140     _die_if_cycle_found_in_also_list_for_package($exporting_package);
 141
 142     return uniq( _follow_also_real($exporting_package) );
 143 }
 144
 145 sub _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
 152 sub _also_list_for_package {
 153     my $package = shift;
 154
 155     if ( !exists $EXPORT_SPEC{$package} ) {
 156         my $loaded = is_class_loaded($package);
 157
 158         die "Package in also ($package) does not seem to "
 159             . "use Moose::Exporter"
 160             . ( $loaded ? "" : " (is it loaded?)" );
 161     }
 162
 163     my $also = $EXPORT_SPEC{$package}{also};
 164
 165     return unless defined $also;
 166
 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)
 172 sub _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 }
 179
 180 sub _die_if_also_list_cycles_back_to_existing_stack {
 181     my ( $also_list, $existing_stack ) = @_;
 182
 183     return unless @$also_list && @$existing_stack;
 184
 185     for my $also_member (@$also_list) {
 186         for my $stack_member (@$existing_stack) {
 187             next unless $also_member eq $stack_member;
 188
 189             die
 190                 "Circular reference in 'also' parameter to Moose::Exporter between "
 191                 . join(
 192                 ', ',
 193                 @$existing_stack
 194                 ) . " and $also_member";
 195         }
 196
 197         _die_if_also_list_cycles_back_to_existing_stack(
 198             [ _also_list_for_package($also_member) ],
 199             [ $also_member, @$existing_stack ],
 200         );
 201     }
 202 }
 203
 204 sub _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
 228 sub _make_sub_exporter_params {
 229     my $class                = shift;
 230     my $packages             = shift;
 231     my $export_recorder      = shift;
 232     my $is_reexport          = shift;
 233     my $meta_lookup_override = shift;
 234
 235     my %exports;
 236     my $current_meta_lookup;
 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
 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
 248         for my $name ( @{ $args->{with_meta} } ) {
 249             my $sub = $class->_sub_from_package( $package, $name )
 250                 or next;
 251
 252             my $fq_name = $package . '::' . $name;
 253
 254             $exports{$name} = $class->_make_wrapped_sub_with_meta(
 255                 $fq_name,
 256                 $sub,
 257                 $export_recorder,
 258                 $meta_lookup,
 259             ) unless exists $exports{$name};
 260         }
 261
 262         for my $name ( @{ $args->{with_caller} } ) {
 263             my $sub = $class->_sub_from_package( $package, $name )
 264                 or next;
 265
 266             my $fq_name = $package . '::' . $name;
 267
 268             $exports{$name} = $class->_make_wrapped_sub(
 269                 $fq_name,
 270                 $sub,
 271                 $export_recorder,
 272             ) unless exists $exports{$name};
 273         }
 274
 275         my @extra_exports = $class->_parse_trait_aliases(
 276             $package, $args->{trait_aliases},
 277         );
 278         for my $name ( @{ $args->{as_is} }, @extra_exports ) {
 279             my ( $sub, $coderef_name );
 280
 281             if ( ref $name ) {
 282                 $sub = $name;
 283
 284                 my $coderef_pkg;
 285                 ( $coderef_pkg, $coderef_name )
 286                     = Class::MOP::get_code_info($name);
 287
 288                 if ( $coderef_pkg ne $package ) {
 289                     $is_reexport->{$coderef_name} = 1;
 290                 }
 291             }
 292             else {
 293                 $sub = $class->_sub_from_package( $package, $name )
 294                     or next;
 295
 296                 $coderef_name = $name;
 297             }
 298
 299             $export_recorder->{$sub} = 1;
 300
 301             $exports{$coderef_name} = sub { $sub }
 302                 unless exists $exports{$coderef_name};
 303         }
 304     }
 305
 306     return \%exports;
 307 }
 308
 309 sub _sub_from_package {
 310     my $sclass  = shift;
 311     my $package = shift;
 312     my $name    = shift;
 313
 314     my $sub = do {
 315         no strict 'refs';
 316         \&{ $package . '::' . $name };
 317     };
 318
 319     return $sub if defined &$sub;
 320
 321     Carp::cluck "Trying to export undefined sub ${package}::${name}";
 322
 323     return;
 324 }
 325
 326 our $CALLER;
 327
 328 sub _make_wrapped_sub {
 329     my $self            = shift;
 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
 343         my $wrapper = $self->_curry_wrapper( $sub, $fq_name, $caller );
 344
 345         my $sub = subname( $fq_name => $wrapper );
 346
 347         $export_recorder->{$sub} = 1;
 348
 349         return $sub;
 350     };
 351 }
 352
 353 sub _make_wrapped_sub_with_meta {
 354     my $self            = shift;
 355     my $fq_name         = shift;
 356     my $sub             = shift;
 357     my $export_recorder = shift;
 358     my $meta_lookup     = shift;
 359
 360     return sub {
 361         my $caller = $CALLER;
 362
 363         my $wrapper = $self->_late_curry_wrapper(
 364             $sub, $fq_name,
 365             $meta_lookup => $caller
 366         );
 367
 368         my $sub = subname( $fq_name => $wrapper );
 369
 370         $export_recorder->{$sub} = 1;
 371
 372         return $sub;
 373     };
 374 }
 375
 376 sub _curry_wrapper {
 377     my $class   = shift;
 378     my $sub     = shift;
 379     my $fq_name = shift;
 380     my @extra   = @_;
 381
 382     my $wrapper = sub { $sub->( @extra, @_ ) };
 383     if ( my $proto = prototype $sub ) {
 384
 385         # XXX - Perl's prototype sucks. Use & to make set_prototype
 386         # ignore the fact that we're passing "private variables"
 387         &Scalar::Util::set_prototype( $wrapper, $proto );
 388     }
 389     return $wrapper;
 390 }
 391
 392 sub _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 {
 400
 401         # resolve curried arguments at runtime via this closure
 402         my @curry = ( $extra->(@ex_args) );
 403         return $sub->( @curry, @_ );
 404     };
 405
 406     if ( my $proto = prototype $sub ) {
 407
 408         # XXX - Perl's prototype sucks. Use & to make set_prototype
 409         # ignore the fact that we're passing "private variables"
 410         &Scalar::Util::set_prototype( $wrapper, $proto );
 411     }
 412     return $wrapper;
 413 }
 414
 415 sub _make_import_sub {
 416     shift;
 417     my $exporting_package = shift;
 418     my $exporter          = shift;
 419     my $exports_from      = shift;
 420     my $is_reexport       = shift;
 421     my $meta_lookup       = shift;
 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
 436         my $metaclass;
 437         ( $metaclass, @_ ) = _strip_metaclass(@_);
 438         $metaclass
 439             = Moose::Util::resolve_metaclass_alias( 'Class' => $metaclass )
 440             if defined $metaclass && length $metaclass;
 441
 442         my $meta_name;
 443         ( $meta_name, @_ ) = _strip_meta_name(@_);
 444
 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
 461         my $did_init_meta;
 462         for my $c ( grep { $_->can('init_meta') } $class, @{$exports_from} ) {
 463
 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.
 467             local $CALLER = $CALLER;
 468             $c->init_meta(
 469                 for_class => $CALLER,
 470                 metaclass => $metaclass,
 471                 meta_name => $meta_name,
 472             );
 473             $did_init_meta = 1;
 474         }
 475
 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
 488         if ( $did_init_meta && @{$traits} ) {
 489
 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;
 494             _apply_meta_traits( $CALLER, $traits, $meta_lookup );
 495         }
 496         elsif ( @{$traits} ) {
 497             require Moose;
 498             Moose->throw_error(
 499                 "Cannot provide traits when $class does not have an init_meta() method"
 500             );
 501         }
 502
 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 );
 513     };
 514 }
 515
 516 sub _strip_traits {
 517     my $idx = first_index { ( $_ || '' ) eq '-traits' } @_;
 518
 519     return ( [], @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
 520
 521     my $traits = $_[ $idx + 1 ];
 522
 523     splice @_, $idx, 2;
 524
 525     $traits = [$traits] unless ref $traits;
 526
 527     return ( $traits, @_ );
 528 }
 529
 530 sub _strip_metaclass {
 531     my $idx = first_index { ( $_ || '' ) eq '-metaclass' } @_;
 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
 542 sub _strip_meta_name {
 543     my $idx = first_index { ( $_ || '' ) eq '-meta_name' } @_;
 544
 545     return ( 'meta', @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
 546
 547     my $meta_name = $_[ $idx + 1 ];
 548
 549     splice @_, $idx, 2;
 550
 551     return ( $meta_name, @_ );
 552 }
 553
 554 sub _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
 576 sub _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
 638 sub _apply_meta_traits {
 639     my ( $class, $traits, $meta_lookup ) = @_;
 640
 641     return unless @{$traits};
 642
 643     my $meta = $meta_lookup->($class);
 644
 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);
 650
 651     my @resolved_traits = map {
 652         ref $_
 653             ? $_
 654             : Moose::Util::resolve_metatrait_alias( $type => $_ )
 655     } @$traits;
 656
 657     return unless @resolved_traits;
 658
 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);
 669 }
 670
 671 sub _get_caller {
 672
 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
 684 sub _make_unimport_sub {
 685     shift;
 686     my $exporting_package = shift;
 687     my $exports           = shift;
 688     my $export_recorder   = shift;
 689     my $is_reexport       = shift;
 690     my $meta_lookup       = shift;
 691
 692     return sub {
 693         my $caller = scalar caller();
 694         Moose::Exporter->_remove_keywords(
 695             $caller,
 696             [ keys %{$exports} ],
 697             $export_recorder,
 698             $is_reexport,
 699         );
 700     };
 701 }
 702
 703 sub _remove_keywords {
 704     shift;
 705     my $package          = shift;
 706     my $keywords         = shift;
 707     my $recorded_exports = shift;
 708     my $is_reexport      = shift;
 709
 710     no strict 'refs';
 711
 712     foreach my $name ( @{$keywords} ) {
 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
 719             if ( $is_reexport->{$name} ) {
 720                 no strict 'refs';
 721                 next
 722                     unless _export_is_flagged(
 723                             \*{ join q{::} => $package, $name } );
 724             }
 725
 726             # and if it is from us, then undef the slot
 727             delete ${ $package . '::' }{$name};
 728         }
 729     }
 730 }
 731
 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
 735 sub _make_init_meta {
 736     shift;
 737     my $class          = shift;
 738     my $args           = shift;
 739     my $meta_lookup    = shift;
 740
 741     my %old_style_roles;
 742     for my $role (
 743         map {"${_}_roles"}
 744         qw(
 745         metaclass
 746         attribute_metaclass
 747         method_metaclass
 748         wrapped_method_metaclass
 749         instance_metaclass
 750         constructor_class
 751         destructor_class
 752         error_class
 753         )
 754         ) {
 755         $old_style_roles{$role} = $args->{$role}
 756             if exists $args->{$role};
 757     }
 758
 759     my %base_class_roles;
 760     %base_class_roles = ( roles => $args->{base_class_roles} )
 761         if exists $args->{base_class_roles};
 762
 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;
 767
 768     return sub {
 769         shift;
 770         my %opts = @_;
 771         $meta_lookup->($opts{for_class});
 772     };
 773 }
 774
 775 sub import {
 776     strict->import;
 777     warnings->import;
 778 }
 779
 780 1;
 781
 782 # ABSTRACT: make an import() and unimport() just like Moose.pm
 783
 784 __END__
 785
 786 =head1 SYNOPSIS
 787
 788   package MyApp::Moose;
 789
 790   use Moose ();
 791   use Moose::Exporter;
 792
 793   Moose::Exporter->setup_import_methods(
 794       with_meta => [ 'has_rw', 'sugar2' ],
 795       as_is     => [ 'sugar3', \&Some::Random::thing ],
 796       also      => 'Moose',
 797   );
 798
 799   sub has_rw {
 800       my ( $meta, $name, %options ) = @_;
 801       $meta->add_attribute(
 802           $name,
 803           is => 'rw',
 804           %options,
 805       );
 806   }
 807
 808   # then later ...
 809   package MyApp::User;
 810
 811   use MyApp::Moose;
 812
 813   has 'name';
 814   has_rw 'size';
 815   thing;
 816
 817   no MyApp::Moose;
 818
 819 =head1 DESCRIPTION
 820
 821 This module encapsulates the exporting of sugar functions in a
 822 C<Moose.pm>-like manner. It does this by building custom C<import> and
 823 C<unimport> methods for your module, based on a spec you provide.
 824
 825 It also lets you "stack" Moose-alike modules so you can export Moose's sugar
 826 as well as your own, along with sugar from any random C<MooseX> module, as
 827 long as they all use C<Moose::Exporter>. This feature exists to let you bundle
 828 a set of MooseX modules into a policy module that developers can use directly
 829 instead of using Moose itself.
 830
 831 To simplify writing exporter modules, C<Moose::Exporter> also imports
 832 C<strict> and C<warnings> into your exporter module, as well as into
 833 modules that use it.
 834
 835 =head1 METHODS
 836
 837 This module provides two public methods:
 838
 839 =over 4
 840
 841 =item  B<< Moose::Exporter->setup_import_methods(...) >>
 842
 843 When you call this method, C<Moose::Exporter> builds custom C<import> and
 844 C<unimport> methods for your module. The C<import> method
 845 will export the functions you specify, and can also re-export functions
 846 exported by some other module (like C<Moose.pm>). If you pass any parameters
 847 for L<Moose::Util::MetaRole>, the C<import> method will also call
 848 C<Moose::Util::MetaRole::apply_metaroles> and
 849 C<Moose::Util::MetaRole::apply_base_class_roles> as needed, after making
 850 sure the metaclass is initialized.
 851
 852 The C<unimport> method cleans the caller's namespace of all the exported
 853 functions. This includes any functions you re-export from other
 854 packages. However, if the consumer of your package also imports those
 855 functions from the original package, they will I<not> be cleaned.
 856
 857 Note that if any of these methods already exist, they will not be
 858 overridden, you will have to use C<build_import_methods> to get the
 859 coderef that would be installed.
 860
 861 This method accepts the following parameters:
 862
 863 =over 8
 864
 865 =item * with_meta => [ ... ]
 866
 867 This list of function I<names only> will be wrapped and then exported. The
 868 wrapper will pass the metaclass object for the caller as its first argument.
 869
 870 Many sugar functions will need to use this metaclass object to do something to
 871 the calling package.
 872
 873 =item * as_is => [ ... ]
 874
 875 This list of function names or sub references will be exported as-is. You can
 876 identify a subroutine by reference, which is handy to re-export some other
 877 module's functions directly by reference (C<\&Some::Package::function>).
 878
 879 If you do export some other package's function, this function will never be
 880 removed by the C<unimport> method. The reason for this is we cannot know if
 881 the caller I<also> explicitly imported the sub themselves, and therefore wants
 882 to keep it.
 883
 884 =item * trait_aliases => [ ... ]
 885
 886 This is a list of package names which should have shortened aliases exported,
 887 similar to the functionality of L<aliased>. Each element in the list can be
 888 either a package name, in which case the export will be named as the last
 889 namespace component of the package, or an arrayref, whose first element is the
 890 package to alias to, and second element is the alias to export.
 891
 892 =item * also => $name or \@names
 893
 894 This is a list of modules which contain functions that the caller
 895 wants to export. These modules must also use C<Moose::Exporter>. The
 896 most common use case will be to export the functions from C<Moose.pm>.
 897 Functions specified by C<with_meta> or C<as_is> take precedence over
 898 functions exported by modules specified by C<also>, so that a module
 899 can selectively override functions exported by another module.
 900
 901 C<Moose::Exporter> also makes sure all these functions get removed
 902 when C<unimport> is called.
 903
 904 =item * meta_lookup => sub { ... }
 905
 906 This is a function which will be called to provide the metaclass
 907 to be operated upon by the exporter. This is an advanced feature
 908 intended for use by package generator modules in the vein of
 909 L<MooseX::Role::Parameterized> in order to simplify reusing sugar
 910 from other modules that use C<Moose::Exporter>. This function is
 911 used, for example, to select the metaclass to bind to functions
 912 that are exported using the C<with_meta> option.
 913
 914 This function will receive one parameter: the class name into which
 915 the sugar is being exported. The default implementation is:
 916
 917     sub { Class::MOP::class_of(shift) }
 918
 919 Accordingly, this function is expected to return a metaclass.
 920
 921 =back
 922
 923 You can also provide parameters for C<Moose::Util::MetaRole::apply_metaroles>
 924 and C<Moose::Util::MetaRole::base_class_roles>. Specifically, valid parameters
 925 are "class_metaroles", "role_metaroles", and "base_class_roles".
 926
 927 =item B<< Moose::Exporter->build_import_methods(...) >>
 928
 929 Returns two code refs, one for C<import> and one for C<unimport>.
 930
 931 Accepts the additional C<install> option, which accepts an arrayref of method
 932 names to install into your exporting package. The valid options are C<import>
 933 and C<unimport>. Calling C<setup_import_methods> is equivalent
 934 to calling C<build_import_methods> with C<< install => [qw(import unimport)] >>
 935 except that it doesn't also return the methods.
 936
 937 The C<import> method is built using L<Sub::Exporter>. This means that it can
 938 take a hashref of the form C<< { into => $package } >> to specify the package
 939 it operates on.
 940
 941 Used by C<setup_import_methods>.
 942
 943 =back
 944
 945 =head1 IMPORTING AND init_meta
 946
 947 If you want to set an alternative base object class or metaclass class, see
 948 above for details on how this module can call L<Moose::Util::MetaRole> for
 949 you.
 950
 951 If you want to do something that is not supported by this module, simply
 952 define an C<init_meta> method in your class. The C<import> method that
 953 C<Moose::Exporter> generates for you will call this method (if it exists). It
 954 will always pass the caller to this method via the C<for_class> parameter.
 955
 956 Most of the time, your C<init_meta> method will probably just call C<<
 957 Moose->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
 966 The C<import> method generated by C<Moose::Exporter> will allow the
 967 user of your module to specify metaclass traits in a C<-traits>
 968 parameter 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
 974 These traits will be applied to the caller's metaclass
 975 instance. Providing traits for an exporting class that does not create
 976 a metaclass for the caller is an error.
 977
 978 =head1 BUGS
 979
 980 See L<Moose/BUGS> for details on reporting bugs.
 981
 982 =cut