view release on metacpan or  search on metacpan

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

  if ($INFO{$role} && $INFO{$role}{inhaled_from_moose}
      or $INC{"Moo.pm"}
      and $m = Moo->_accessor_maker_for($target)
      and ref($m) ne 'Method::Generate::Accessor') {
    $self->_make_accessors($target, $role);
  }
}

sub _make_accessors_if_moose {
  my ($self, $target, $role) = @_;
  if ($INFO{$role} && $INFO{$role}{inhaled_from_moose}) {
    $self->_make_accessors($target, $role);
  }
}

sub _make_accessors {
  my ($self, $target, $role) = @_;
  my $acc_gen = ($Moo::MAKERS{$target}{accessor} ||= do {
    require Method::Generate::Accessor;
    Method::Generate::Accessor->new
  });
  my $con_gen = $Moo::MAKERS{$target}{constructor};
  my @attrs = @{$INFO{$role}{attributes}||[]};
  while (my ($name, $spec) = splice @attrs, 0, 2) {
    # needed to ensure we got an index for an arrayref based generator
    if ($con_gen) {
      $spec = $con_gen->all_attribute_specs->{$name};
    }
    $acc_gen->generate_method($target, $name, $spec);
  }
}

sub _undefer_subs {
  my ($self, $target, $role) = @_;
  if ($INC{'Sub/Defer.pm'}) {
    Sub::Defer::undefer_package($role);
  }
}

sub role_application_steps {
  qw(_handle_constructor _undefer_subs _maybe_make_accessors),
    $_[0]->SUPER::role_application_steps;
}

sub _build_class_with_roles {
  my ($me, $new_name, $superclass, @roles) = @_;
  $Moo::MAKERS{$new_name} = {is_class => 1};
  $me->SUPER::_build_class_with_roles($new_name, $superclass, @roles);

  if ($INC{'Moo/HandleMoose.pm'} && !$Moo::sification::disabled) {
    Moo::HandleMoose::inject_fake_metaclass_for($new_name);
  }

  my $lvl = 0;
  my $file;
  while ((my $pack, $file) = caller($lvl++)) {
    if ($pack ne __PACKAGE__ && $pack ne 'Role::Tiny' && !$pack->isa($me)) {
      last;
    }
  }
  _set_loaded($new_name, $file || (caller)[1]);

  return $new_name;
}

sub _gen_apply_defaults_for {
  my ($me, $class, @roles) = @_;

  my @attrs = map @{$INFO{$_}{attributes}||[]}, @roles;

  my $con_gen;
  my $m;

  return undef
    unless $INC{'Moo.pm'}
    and @attrs
    and $con_gen = Moo->_constructor_maker_for($class)
    and $m = Moo->_accessor_maker_for($class);

  my $specs = $con_gen->all_attribute_specs;

  my %seen;
  my %captures;
  my @set;
  while (my ($name, $spec) = splice @attrs, 0, 2) {
    next
      if $seen{$name}++;

    next
      unless $m->has_eager_default($name, $spec);

    my ($has, $has_cap)
      = $m->generate_simple_has('$_[0]', $name, $spec);
    my ($set, $pop_cap)
      = $m->generate_use_default('$_[0]', $name, $spec, $has);

    @captures{keys %$has_cap, keys %$pop_cap}
      = (values %$has_cap, values %$pop_cap);

    push @set, $set;
  }

  return undef
    if !@set;

  my $code = join '', map "($_),", @set;
  no warnings 'void';
  require Sub::Quote;
  return Sub::Quote::quote_sub(
    "${class}::_apply_defaults",
    $code,
    \%captures,
    {
      package => $class,
      no_install => 1,
      no_defer => 1,
    }
  );
}

sub apply_roles_to_object {
  my ($me, $object, @roles) = @_;
  my $new = $me->SUPER::apply_roles_to_object($object, @roles);
  my $class = ref $new;
  _set_loaded($class, (caller)[1]);

  if (!exists $APPLY_DEFAULTS{$class}) {
    $APPLY_DEFAULTS{$class} = $me->_gen_apply_defaults_for($class, @roles);
  }
  if (my $apply_defaults = $APPLY_DEFAULTS{$class}) {
    local $Carp::Internal{+__PACKAGE__} = 1;
    local $Carp::Internal{$class} = 1;
    $new->$apply_defaults;
  }
  return $new;
}

sub _install_single_modifier {
  my ($me, @args) = @_;
  _install_modifier(@args);
}

sub _install_does {
    my ($me, $to) = @_;

    # If Role::Tiny actually installed the DOES, give it a name
    my $new = $me->SUPER::_install_does($to) or return;
    return _name_coderef("${to}::DOES", $new);
}

sub does_role {
  my ($proto, $role) = @_;
  return 1
    if Role::Tiny::does_role($proto, $role);
  my $meta;
  if ($INC{'Moose.pm'}
      and $meta = Class::MOP::class_of($proto)
      and ref $meta ne 'Moo::HandleMoose::FakeMetaClass'
      and $meta->can('does_role')
  ) {
    return $meta->does_role($role);
  }
  return 0;
}

sub _handle_constructor {
  my ($me, $to, $role) = @_;
  my $attr_info = $INFO{$role} && $INFO{$role}{attributes};
  return unless $attr_info && @$attr_info;
  my $info = $INFO{$to};
  my $con = $INC{"Moo.pm"} && Moo->_constructor_maker_for($to);
  my %existing
    = $info ? @{$info->{attributes} || []}
    : $con  ? %{$con->all_attribute_specs || {}}
    : ();

  my @attr_info =
    map { @{$attr_info}[$_, $_+1] }
    grep { ! $existing{$attr_info->[$_]} }
    map { 2 * $_ } 0..@$attr_info/2-1;

  if ($info) {
    push @{$info->{attributes}||=[]}, @attr_info;
  }
  elsif ($con) {