1

我有一个 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 属性已定义但 table 属性未定义。

有谁知道为什么 Role 中定义的 'id' 属性不会从元类中排除,但 'table' class_attribute 会?如上所述,问题在于 Some::Module 的用户在需要调用 module_id() 时可以调用 id()。

此外,当转储 $some_module 对象时,“id”不会出现在转储中。

编辑:

这是一个说明问题的示例。我已经定义了一个实现 id 的角色,然后我正在使用包 My::Product 中的角色。但是,我在使用 id 时将其排除在外。当我从元对象打印属性时,它表明它实际上存在。我的印象是,在使用角色时从角色中排除 id 将不允许调用它。我希望它不仅不在元对象中,而且在尝试调用它时也会死掉。

#!/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_exclusions 中。

 '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' )
                      ]
4

1 回答 1

2

我不知道它的内部是如何工作的,但我相信这与您排除的两种方法是属性方法有关。我能找到的唯一相关文章是here,上面写着:

角色属性与类的属性相似,只是它们并未实际应用。这意味着属性访问器生成的方法不会在角色中生成,而只会在角色应用于类时创建

因此我猜问题是当你的类被构建时,角色被应用(并且方法被排除),但之后角色的属性被应用并且访问器方法(包括id和first_name)被构造。

为了演示,将 id 属性更改为 _id,给它一个不同的 writer 并创建一个 id sub 来访问它:

# 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.
于 2015-06-12T14:45:07.533 回答