Почему Moose Role не исключает исключение определенных атрибутов роли?

Question

У меня есть Moose::Role, которая имеет (среди прочего):

package My::Role;

use strict;
use warnings;

use Moose::Role;
use MooseX::ClassAttribute;

class_has table => (
    is => 'ro'
    isa => 'Str',
    lazy => 1,
);

has id => (
    is => 'ro',
    isa => 'Int',
    predicate => 'has_id',
    writer => '_id',
    required => 0,
);

has other => (
    is => 'rw',
    isa => 'Int',
);

...

1;

Затем в модуле, который потребляет эту роль,

package Some::Module;

with 'My::Role' => {
    -excludes => [qw( id table )]
};

has module_id => (
    is => 'ro',
    isa => 'Int',
);
...

1;

Затем в сценарии я создаю экземпляр экземпляра Some::Module:

my $some_module = Some::Module->new({ other => 3 });

и я могу позвонить

$some_module->id;  # I'd expect this to die but returns undef.

Однако я не могу позвонить

$some_module->table;  # this dies as I'd expect

Как и следовало ожидать, вызов $some_module->table приводит к прекращению работы скрипта. Вызов $some_module->id не делает.

Когда я использую Data::Dumper для выгрузки списка атрибутов метакласса $ some_module, он показывает, что атрибут id определен, а атрибут таблицы - нет.

Кто-нибудь знает, почему атрибут "id", определенный в роли, не будет исключен из мета-класса, а атрибут "table" class_attribute? Проблема, как описано выше, заключается в том, что пользователи Some:: Module могут вызывать id(), когда они должны вызывать module_id().

Кроме того, при выгрузке объекта $ some_module, идентификатор не отображается в дампе.

Редактировать:

Вот пример, который иллюстрирует проблему. Я определил роль, которая реализует идентификатор, затем я использую роль в пакете My::Product. Я исключаю идентификатор при его потреблении, однако. Когда я печатаю атрибут из мета-объекта, он показывает, что он на самом деле там. У меня сложилось впечатление, что исключение идентификатора из роли при его использовании не позволит его вызвать. Я ожидаю, что это будет не только НЕ в мета-объекте, но и умрет при попытке вызвать его.

#!/usr/bin/perl

package My::Model;

use Moose::Role;
use MooseX::ClassAttribute;

class_has first_name => (
    is  => 'rw',
    isa => 'Str',
);

class_has last_name => (
    is  => 'rw',
    isa => 'Str',
);

has id => (
    is        => 'rw',
    isa       => 'Int',
    predicate => 'has_id',
    writer    => '_id',
    required  => 0,
);

1;

package My::Product;

use Moose;
use Class::MOP::Class;
use Data::Dumper;

with 'My::Model' => { -excludes => [ qw( first_name id ) ], };

has count => (
    is => 'rw',
    isa => 'Int',
);

has product_id => (
    is        => 'ro',
    isa       => 'Int',
    required  => 0,
    predicate => 'has_product_id'
);

sub create_classes {
    my @list = ();
    foreach my $subclass (qw( one two three )) {
          Class::MOP::Class->create(
            "My::Product::"
              . $subclass => (
                superclasses => ["My::Product"],
              )
          );
        push @list, "My::Product::$subclass";
    }

    return \@list;
}

__PACKAGE__->meta()->make_immutable;

1;

package main;

use strict;
use warnings;
use Data::Dumper;

my $product = My::Product->new();
my $classes = $product->create_classes();

my @class_list;
foreach my $class ( @{ $classes } ) {
    my $temp = $class->new( { count => time } );
    $temp->first_name('Don');
    $temp->last_name('MouseCop');
    push @class_list, $temp;
}

warn "what is the id for the first obj => " . $class_list[0]->id ;
warn "what is the first_name for the first obj => " . $class_list[0]->first_name ;
warn "what is the last_name for the first obj => " . $class_list[0]->last_name ;

warn "\nAttribute list:\n";
foreach my $attr ( $class_list[2]->meta->get_all_attributes ) {
    warn "name => " . $attr->name;
#    warn Dumper( $attr );
}

Редактировать 2: После сброса $attr я вижу, что first_name и id находятся в method_exclusion.

 'role_applications' => [
                        bless( {
                                 'class' => $VAR1->{'associated_class'},
                                 'role' => $VAR1->{'associated_class'}{'roles'}[0],
                                 'method_aliases' => {},
                                 'method_exclusions' => [
                                                          'first_name',
                                                          'id'
                                                        ]
                               }, 'Moose::Meta::Class::__ANON__::SERIAL::8' )
                      ]

Answer 1

Я понятия не имею, как это работает, но я считаю, что это связано с тем фактом, что два метода, которые вы исключаете, являются методами атрибутов. Единственная соответствующая статья, которую я могу найти, находится здесь, где говорится:

Атрибуты ролей аналогичны атрибутам класса, за исключением того, что они на самом деле не применяются. Это означает, что методы, сгенерированные средством доступа к атрибутам, не будут сгенерированы в роли, а будут созданы только после применения роли к классу.

Поэтому я предполагаю, что проблема в том, что когда ваши классы создаются, роль применяется (и методы исключаются), но после этого применяются атрибуты роли и создаются методы доступа (включая id и first_name).

Чтобы продемонстрировать, измените атрибут id на _id, назначьте ему другого автора и создайте подпрограмму id для доступа к нему:

# This replaces id
has _id => (
    is        => 'rw',
    isa       => 'Int',
    writer => 'set_id',
    required  => 0,
);

sub id {
    my $self = shift;
    return $self->_id();
}

Скрипт теперь умрет с исключением:

Can't locate object method "id" via package "My::Product::one" at ./module.pm line 89.