view release on metacpan or  search on metacpan

lib/Moose/Exporter.pm  view on Meta::CPAN

    my $wrapper = sub {

        # resolve curried arguments at runtime via this closure
        my @curry = ( $extra->(@ex_args) );
        return $sub->( @curry, @_ );
    };

    if ( my $proto = prototype $sub ) {

        # XXX - Perl's prototype sucks. Use & to make set_prototype
        # ignore the fact that we're passing "private variables"
        &Scalar::Util::set_prototype( $wrapper, $proto );
    }
    return $wrapper;
}

sub _make_import_sub {
    shift;
    my $exporting_package = shift;
    my $exporter          = shift;
    my $exports_from      = shift;
    my $is_reexport       = shift;
    my $meta_lookup       = shift;

    return sub {

        # I think we could use Sub::Exporter's collector feature
        # to do this, but that would be rather gross, since that
        # feature isn't really designed to return a value to the
        # caller of the exporter sub.
        #
        # Also, this makes sure we preserve backwards compat for
        # _get_caller, so it always sees the arguments in the
        # expected order.
        my $traits;
        ( $traits, @_ ) = _strip_traits(@_);

        my $metaclass;
        ( $metaclass, @_ ) = _strip_metaclass(@_);
        $metaclass
            = Moose::Util::resolve_metaclass_alias( 'Class' => $metaclass )
            if defined $metaclass && length $metaclass;

        my $meta_name;
        ( $meta_name, @_ ) = _strip_meta_name(@_);

        # Normally we could look at $_[0], but in some weird cases
        # (involving goto &Moose::import), $_[0] ends as something
        # else (like Squirrel).
        my $class = $exporting_package;

        $CALLER = _get_caller(@_);

        # this works because both pragmas set $^H (see perldoc
        # perlvar) which affects the current compilation -
        # i.e. the file who use'd us - which is why we don't need
        # to do anything special to make it affect that file
        # rather than this one (which is already compiled)

        strict->import;
        warnings->import;

        my $did_init_meta;
        for my $c ( grep { $_->can('init_meta') } $class, @{$exports_from} ) {

            # init_meta can apply a role, which when loaded uses
            # Moose::Exporter, which in turn sets $CALLER, so we need
            # to protect against that.
            local $CALLER = $CALLER;
            $c->init_meta(
                for_class => $CALLER,
                metaclass => $metaclass,
                meta_name => $meta_name,
            );
            $did_init_meta = 1;
        }

        {
            # The metaroles will use Moose::Role, which in turn uses
            # Moose::Exporter, which in turn sets $CALLER, so we need
            # to protect against that.
            local $CALLER = $CALLER;
            _apply_metaroles(
                $CALLER,
                [$class, @$exports_from],
                $meta_lookup
            );
        }

        if ( $did_init_meta && @{$traits} ) {

            # The traits will use Moose::Role, which in turn uses
            # Moose::Exporter, which in turn sets $CALLER, so we need
            # to protect against that.
            local $CALLER = $CALLER;
            _apply_meta_traits( $CALLER, $traits, $meta_lookup );
        }
        elsif ( @{$traits} ) {
            throw_exception( ClassDoesNotHaveInitMeta => class_name => $class,
                                                         traits     => $traits
                           );
        }

        my ( undef, @args ) = @_;
        my $extra = shift @args if ref $args[0] eq 'HASH';

        $extra ||= {};
        if ( !$extra->{into} ) {
            $extra->{into_level} ||= 0;
            $extra->{into_level}++;
        }

        $class->$exporter( $extra, @args );
    };
}

sub _strip_option {
    my $option_name = shift;
    my $default = shift;
    for my $i ( 0 .. $#_ - 1 ) {

lib/Moose/Exporter.pm  view on Meta::CPAN

            # make sure it is from us
            next unless $recorded_exports->{$sub};

            if ( $is_reexport->{$name} ) {
                no strict 'refs';
                next
                    unless _export_is_flagged(
                            \*{ join q{::} => $package, $name } );
            }

            # and if it is from us, then undef the slot
            delete ${ $package . '::' }{$name};
        }
    }
}

# maintain this for now for backcompat
# make sure to return a sub to install in the same circumstances as previously
# but this functionality now happens at the end of ->import
sub _make_init_meta {
    shift;
    my $class          = shift;
    my $args           = shift;
    my $meta_lookup    = shift;

    my %old_style_roles;
    for my $role (
        map {"${_}_roles"}
        qw(
        metaclass
        attribute_metaclass
        method_metaclass
        wrapped_method_metaclass
        instance_metaclass
        constructor_class
        destructor_class
        error_class
        )
        ) {
        $old_style_roles{$role} = $args->{$role}
            if exists $args->{$role};
    }

    my %base_class_roles;
    %base_class_roles = ( roles => $args->{base_class_roles} )
        if exists $args->{base_class_roles};

    my %new_style_roles = map { $_ => $args->{$_} }
        grep { exists $args->{$_} } qw( class_metaroles role_metaroles );

    return unless %new_style_roles || %old_style_roles || %base_class_roles;

    return sub {
        shift;
        my %opts = @_;
        $meta_lookup->($opts{for_class});
    };
}

sub import {
    strict->import;
    warnings->import;
}

1;

# ABSTRACT: make an import() and unimport() just like Moose.pm

__END__

=pod

=encoding UTF-8

=head1 NAME

Moose::Exporter - make an import() and unimport() just like Moose.pm

=head1 VERSION

version 2.4000

=head1 SYNOPSIS

  package MyApp::Moose;

  use Moose ();
  use Moose::Exporter;
  use Some::Random ();

  Moose::Exporter->setup_import_methods(
      with_meta => [ 'has_rw', 'sugar2' ],
      as_is     => [ 'sugar3', \&Some::Random::thing, 'Some::Random::other_thing' ],
      also      => 'Moose',
  );

  sub has_rw {
      my ( $meta, $name, %options ) = @_;
      $meta->add_attribute(
          $name,
          is => 'rw',
          %options,
      );
  }

  # then later ...
  package MyApp::User;

  use MyApp::Moose;

  has 'name' => ( is => 'ro' );
  has_rw 'size';
  thing;
  other_thing;

  no MyApp::Moose;

=head1 DESCRIPTION

This module encapsulates the exporting of sugar functions in a
C<Moose.pm>-like manner. It does this by building custom C<import> and