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