Just a little More 2.

So To carry on from my last short post another short post. I am going to expand and modify my 20_dad_load.t again this time digging a little deeper in Moose's MOP or to give its full name 'Meta-Object Protocol'

One of the things I like most about moose is how easy it is to do “Introspection” or I like to say 'Lets have a look under the hood'. So I have expanded my role test from the other day to this

foreach my $attribute ($da->meta->get_all_attributes){
if (index($attribute->name(),'_') eq 0);
my $dad_attribute = ucfirst($attribute->name());
if ($dad_role->can($dad_attribute)){
pass("Role DAD can $dad_attribute");
my $attr = $dad_role->meta->get_attribute($dad_attribute);
if ($attribute->type_constraint() eq $attr->type_constraint()){
pass("Role DAD attribute: $dad_attribute had correct type of ".$attribute->type_constraint());
else {
fail("Role DAD attribute: $dad_attribute had in correct type of ".$attr->type_constraint().". Should be a ".$attribute->type_constraint());
ok ($attr->{is} eq 'ro', "Role DAD attribute: $dad_attribute is Read Only")
fail("Role DAD can $dad_attribute");


So lets have a look at the interesting parts. We have seen before the 'get_all_attributes' call and you will notice it is being called against the 'meta' attribute which is the gateway into MOP. All Moose classes will have this attribute and it can be used for all sorts of fiendish purposes and many useful ones.

I have changed my simple

  ok($dad_role->can($dad_attribute),"Role DAD can $dad_attribute") ;

test over to an if else using either 'pass' if my $dad_role 'can' do the $dad_attribute or 'fail' it it can't, I do love this feature of Test::More. On a 'pass' I the take the $dad_attribute and use it with

my $attr = $dad_role->meta->get_attribute($dad_attribute);

to get the Attribute object with that name. Once I have that I use MOP once again in the next test to ensure the 'type' constraint of the original Accessor class ($da) attribute and the corresponding DAD attribute ($attr) are the same.

Finally I do a very bad thing here, I check a value if the 'is' on the $attr object to ensure that it is read only.

ok ($attr->{is} eq 'ro', "Role DAD attribute: $dad_attribute is Read Only");

danger will.png

This is really not something you should be doing. Myself and many other long in the tooth perl types always say check an instance value with an accessor and not directly. This is the major complaint heard from many other about OO programmers abut OO perl, i.e. 'How can it be object orientated if you can change values without a setter and see values without a getter!'

I guess java.util.Stack.push doesn't count.

Now we may not have a MOP accessor for 'is' but we do have a way to tell if an attribute is read only. As you know Moose takes care of creating the setter and getter when you set something to 'rw'. Likewise when an attribute is set to 'ro' there is only a getter created. Knowing this and given the imormational attribute MOP calls 'get_read_method' and 'get_write_method' we can create a test. So by testing if there is no wtire method we indirectly check that the attribute is 'ro'. So I ripped that first test out and added this

ok ($attr->get_write_method eq undef, "Role DAD attribute: $dad_attribute is Read Only")

Now I run my tests and I get;
ok 4 - Role DAD can View

not ok 5 - Role DAD attribute: View had in correct type of Object. Should be a View

ok 6 - Role DAD attribute: View is Read Only

ok 7 - Role DAD can Elements

not ok 8 - Role DAD attribute: Elements had in correct type of ArrayRef. Should be a ArrayRefofElements

ok 9 - Role DAD attribute: Elements is Read Only

ok 10 - Role DAD can Conditions

not ok 11 - Role DAD attribute: Conditions had in correct type of ArrayRef. Should be a ArrayRefofPredicates

ok 12 - Role DAD attribute: Conditions is Read Only

Exactly what I want;

  • My role has all the cosponsoring upper first attributes from Accessor

  • The types should be the same (yeah I know I failed these but I will fix them later) and

  • All for the role attributes are Read Only


Leave a comment

About byterock

user-pic Long time Perl guy, a few CPAN mods allot of work on DBD::Oracle and a few YAPC presentations