Question

I currently use a block eval to test that I’ve set an attribute as read-only. Is there a simpler way to do this?

Example from working code:

#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");

UPDATE


Thanks to friedo, Ether, and Robert P for their answers and to Ether, Robert P, and jrockway for their comments.

I like how Ether’s answer ensures that $is_read_only is only a true or false value (i.e. but never a coderef) by negating it with a !. Double negation also provides that. Thus, you can use $is_read_only in an is() function, without it printing out the coderef.

See Robert P’s answer below for the most complete answer. Everyone has been very helpful and built on each other’s answers and comments. Overall, I think he’s helped me the most, hence his is now marked the accepted answer. Again, thanks to Ether, Robert P, friedo, and jrockway.

In case you might be wondering, as I did at first, here is documentation about the difference between get_attribute and find_attribute_by_name (from Class::MOP::Class):

$metaclass->get_attribute($attribute_name)

    This will return a Class::MOP::Attribute for the specified $attribute_name. If the 
    class does not have the specified attribute, it returns undef.

    NOTE that get_attribute does not search superclasses, for that you need to use
    find_attribute_by_name.

Answer 1

Technically, an attribute does not need to have a read or a write method. Most of the time it will, but not always. An example (graciously stolen from jrockway’s comment) is below:

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

This attribute will exist, but not have standard readers and writers.

So to test in every situation that an attribute has been defined as is => 'RO', you need to check both the write and the read method. You could do it with this subroutine:

# 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());
}

Alternatively, you could add a double negation before the last return to boolify the return value:

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