view release on metacpan or  search on metacpan

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

  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 apply_roles_to_package {
  my ($me, $to, @roles) = @_;
  foreach my $role (@roles) {
    _load_module($role);
    $me->_inhale_if_moose($role);
    croak "${role} is not a Moo::Role" unless $me->is_role($role);
  }
  $me->SUPER::apply_roles_to_package($to, @roles);
}

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

sub create_class_with_roles {
  my ($me, $superclass, @roles) = @_;

  my ($new_name, $compose_name) = $me->_composite_name($superclass, @roles);

  return $new_name if $COMPOSED{class}{$new_name};

  foreach my $role (@roles) {
    _load_module($role);
    $me->_inhale_if_moose($role);
    croak "${role} is not a Moo::Role" unless $me->is_role($role);
  }

  my $m;
  if ($INC{"Moo.pm"}
      and $m = Moo->_accessor_maker_for($superclass)
      and ref($m) ne 'Method::Generate::Accessor') {
    # old fashioned way time.
    @{*{_getglob("${new_name}::ISA")}{ARRAY}} = ($superclass);
    $Moo::MAKERS{$new_name} = {is_class => 1};
    $me->apply_roles_to_package($new_name, @roles);
  }
  else {
    $me->SUPER::create_class_with_roles($superclass, @roles);
    $Moo::MAKERS{$new_name} = {is_class => 1};
    $me->_handle_constructor($new_name, $_) for @roles;
  }

  if ($INC{'Moo/HandleMoose.pm'} && !$Moo::sification::disabled) {
    Moo::HandleMoose::inject_fake_metaclass_for($new_name);
  }
  $COMPOSED{class}{$new_name} = 1;
  _set_loaded($new_name, (caller)[1]);
  return $new_name;
}

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]);

  my $apply_defaults = exists $APPLY_DEFAULTS{$class} ? $APPLY_DEFAULTS{$class}
    : $APPLY_DEFAULTS{$class} = do {
    my %attrs = map { @{$INFO{$_}{attributes}||[]} } @roles;

    if ($INC{'Moo.pm'}
        and keys %attrs
        and my $con_gen = Moo->_constructor_maker_for($class)
        and my $m = Moo->_accessor_maker_for($class)) {

      my $specs = $con_gen->all_attribute_specs;

      my %captures;
      my $code = join('',
        ( map {
          my $name = $_;
          my $spec = $specs->{$name};
          if ($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);
            "($set),";
          }
          else {
            ();
          }
        } sort keys %attrs ),
      );
      if ($code) {
        require Sub::Quote;
        Sub::Quote::quote_sub(
          "${class}::_apply_defaults",
          "no warnings 'void';\n$code",
          \%captures,
          {
            package => $class,
            no_install => 1,
          }
        );
      }
      else {
        0;
      }
    }
    else {
      0;
    }
  };
  if ($apply_defaults) {
    local $Carp::Internal{+__PACKAGE__} = 1;
    local $Carp::Internal{$class} = 1;
    $new->$apply_defaults;
  }
  return $new;
}