我有一个 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' )
]