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