view release on metacpan or  search on metacpan

local/lib/perl5/Moo/Role.pm  view on Meta::CPAN

}

sub import {
  my $target = caller;
  if ($Moo::MAKERS{$target} and $Moo::MAKERS{$target}{is_class}) {
    croak "Cannot import Moo::Role into a Moo class";
  }
  _set_loaded(caller);
  goto &Role::Tiny::import;
}

sub _install_subs {
  my ($me, $target) = @_;
  _install_tracked $target => has => sub {
    my $name_proto = shift;
    my @name_proto = ref $name_proto eq 'ARRAY' ? @$name_proto : $name_proto;
    if (@_ % 2 != 0) {
      croak("Invalid options for " . join(', ', map "'$_'", @name_proto)
        . " attribute(s): even number of arguments expected, got " . scalar @_)
    }
    my %spec = @_;
    foreach my $name (@name_proto) {
      my $spec_ref = @name_proto > 1 ? +{%spec} : \%spec;
      ($INFO{$target}{accessor_maker} ||= do {
        require Method::Generate::Accessor;
        Method::Generate::Accessor->new
      })->generate_method($target, $name, $spec_ref);
      push @{$INFO{$target}{attributes}||=[]}, $name, $spec_ref;
      $me->_maybe_reset_handlemoose($target);
    }
  };
  # install before/after/around subs
  foreach my $type (qw(before after around)) {
    _install_tracked $target => $type => sub {
      push @{$INFO{$target}{modifiers}||=[]}, [ $type => @_ ];
      $me->_maybe_reset_handlemoose($target);
    };
  }
  _install_tracked $target => requires => sub {
    push @{$INFO{$target}{requires}||=[]}, @_;
    $me->_maybe_reset_handlemoose($target);
  };
  _install_tracked $target => with => sub {
    $me->apply_roles_to_package($target, @_);
    $me->_maybe_reset_handlemoose($target);
  };
  *{_getglob("${target}::meta")} = $me->can('meta');
}

push @ON_ROLE_CREATE, sub {
  my $target = shift;
  if ($INC{'Moo/HandleMoose.pm'} && !$Moo::sification::disabled) {
    Moo::HandleMoose::inject_fake_metaclass_for($target);
  }
};

# duplicate from Moo::Object
sub meta {
  require Moo::HandleMoose::FakeMetaClass;
  my $class = ref($_[0])||$_[0];
  bless({ name => $class }, 'Moo::HandleMoose::FakeMetaClass');
}

sub unimport {
  my $target = caller;
  _unimport_coderefs($target, $INFO{$target});
}

sub _maybe_reset_handlemoose {
  my ($class, $target) = @_;
  if ($INC{'Moo/HandleMoose.pm'} && !$Moo::sification::disabled) {
    Moo::HandleMoose::maybe_reinject_fake_metaclass_for($target);
  }
}

sub methods_provided_by {
  my ($self, $role) = @_;
  _load_module($role);
  $self->_inhale_if_moose($role);
  croak "${role} is not a Moo::Role" unless $self->is_role($role);
  return $self->SUPER::methods_provided_by($role);
}

sub is_role {
  my ($self, $role) = @_;
  $self->_inhale_if_moose($role);
  $self->SUPER::is_role($role);
}

sub _inhale_if_moose {
  my ($self, $role) = @_;
  my $meta;
  if (!$self->SUPER::is_role($role)
      and (
        $INC{"Moose.pm"}
        and $meta = Class::MOP::class_of($role)
        and ref $meta ne 'Moo::HandleMoose::FakeMetaClass'
        and $meta->isa('Moose::Meta::Role')
      )
      or (
        Mouse::Util->can('find_meta')
        and $meta = Mouse::Util::find_meta($role)
        and $meta->isa('Mouse::Meta::Role')
     )
  ) {
    my $is_mouse = $meta->isa('Mouse::Meta::Role');
    $INFO{$role}{methods} = {
      map +($_ => $role->can($_)),
        grep $role->can($_),
        grep !($is_mouse && $_ eq 'meta'),
        grep !$meta->get_method($_)->isa('Class::MOP::Method::Meta'),
          $meta->get_method_list
    };
    $APPLIED_TO{$role} = {
      map +($_->name => 1), $meta->calculate_all_roles
    };
    $INFO{$role}{requires} = [ $meta->get_required_method_list ];
    $INFO{$role}{attributes} = [
      map +($_ => do {
        my $attr = $meta->get_attribute($_);
        my $spec = { %{ $is_mouse ? $attr : $attr->original_options } };