Perl 是否有一种简单的方法来测试Moose属性是否为只读？

我目前使用一个block

eval

来测试我是否已将属性设置为只读。有没有更简单的方法

工作代码示例：

#Test that sample_for is ready only
eval { $snp_obj->sample_for('t/sample_manifest2.txt');};
like($@, qr/read-only/xms, "'sample_for' is read-only");

更新

感谢friedo、Ether和Robert P的回答，感谢Ether、Robert P和jrockway的评论。

我喜欢以太的回答通过用

求反来确保
$is_read_only
仅为真值或假值（即，但决不是coderef）。还规定,。因此，您可以在
is（）
函数中使用
$is\u read\u
，而无需打印coderef

有关最完整的答案，请参见下面Robert p的答案。每个人都非常乐于助人，并建立在彼此的回答和评论的基础上。总的来说，我认为他对我帮助最大，因此他的答案现在被认为是公认的。再次感谢以太、罗伯特·P、弗里多和jrockway





如果您可能想知道，正如我一开始所做的那样，下面是关于
get_attribute
和
find_attribute_by_name
（）之间区别的文档：

如以下文件所述：

$attr->get_write_method（）

unless ( $snp_obj->meta->get_attribute( 'sample_for' )->get_write_method ) { 
    # no write method, so it's read-only
}

有关详细信息，请参阅。
从技术上讲，属性不需要具有读取或写入方法。大多数时候会，但不总是。下面是一个例子（优雅地从中偷来）：

has foo => ( 
    isa => 'ArrayRef', 
    traits => ['Array'], 
    handles => { add_foo => 'push', get_foo => 'pop' }
)

此属性将存在，但不具有标准读取器和写入器

因此，要在每种情况下测试一个属性被定义为
is=>'RO'
，您需要同时检查write和read方法。您可以使用此子例程执行此操作：

# returns the read method if it exists, or undef otherwise.
sub attribute_is_read_only {
    my ($obj, $attribute_name) = @_;
    my $attribute = $obj->meta->get_attribute($attribute_name);

    return unless defined $attribute;
    return (! $attribute->get_write_method() && $attribute->get_read_method());
}

或者，您可以在最后一个
返回之前添加一个双否定，以增强返回值：

return !! (! $attribute->get_write_method() && $attribute->get_read_method());

谢谢知道它返回
undef
允许一行测试（我试着在这里发布它，但它看起来不太好看）。。。测试它是否有写方法。但这并不测试它是否有读取方法。从技术上讲，它也不必有。如果没有，它不是一个非常有用的属性，但是你可以拥有它@罗伯特：是的，严格来说，它检查属性是否“不可写”（不是isa=>'rw'），这与“只读”（isa=>'ro'）不同。没有读卡器的属性非常有用。考虑<代码>有Foo= >（ISA＝>‘ARARYEFF’，Mys= > [ [数组] ]，句柄= > {AddioFoo= > Pube，GETSyFoo= > 'POP' } 。不需要读者@jrockway这是一个没有读写器的属性的极好例子。谢谢这最好写成
ok（$snp_obj->meta->get_属性（'sample_for'）->get_write_方法（），“'sample_for'是只读的”）--测试失败时，
is（）
打印第二个参数（可能是coderef）。。更不用说你的第一个和第二个参数颠倒了：
是（$has，$expected，$test\u name）
。如果你的@attribute\u names数组是精心构造的，你应该没问题；但如果该属性不存在，您将爆炸：）+1，以说明如何在超类中定位该属性
# returns the read method if it exists, or undef otherwise.
sub attribute_is_read_only {
    my ($obj, $attribute_name) = @_;
    my $attribute = $obj->meta->get_attribute($attribute_name);

    return unless defined $attribute;
    return (! $attribute->get_write_method() && $attribute->get_read_method());
}

return !! (! $attribute->get_write_method() && $attribute->get_read_method());