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){
next
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")
}
else{
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");
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 Viewnot 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