Cool Moose

In yesterday's Moose-pen I hinted that I would be getting all my test in order. Well I did that and checked them in but there really was not that much to report on. Just a lot of repetitive code. I suppose I could write one test case to check all of my Database::Accessor classes using some simpler iteration over a list but I really like having a separate test case for all my classes as there really is only a small part that is common between them, so onto something different today.

I am going to start filling in the attributes of my various embedded Database::Accessor classes and I guess the best place to start in with Database::Accessor::View.

Right now I have just the two, 'name' and 'alias', I was thinking of adding another called is_read_only as sometimes a Data Modeler my want a table that you can see but can't manipulate. However, I think that would be better served as a Accessosr.pm level attribute so I going to added it in there.

Well that got me thinking there are times when you want to be able to add to but not update, and times when you want to update but not add and times when you never want to delete and those are just the ones off the top of my head. So I put my thinking moose on and came up with

  • no_create
  • no_retrieve
  • no_update
  • no_delete

Now I could create a whole matrix of off and on attributes I could stretch the above to include ones like


  • create_only
  • retrieve_only
  • update_only
  • delete_only

So I think it is best to keep the first four and add one more


  • retrieve_only


as that is the one I can see being used the most. Now to add the first five in lets do some cool Moosey code. Once you get playing with Moose for a while you quickly learn is that 'has' can be used in an alternate way. It can be called an Array-Ref of Attribute name linked to a hash set of options. Like this;

has [
qw(no_create
no_retrieve
no_update
no_delete
retrieve_only
)
] => ( is => 'ro', isa => 'Bool', default=>0 );

Bingo five attributes in the space it take for one. You will notice that I made them all 'ro' and I want it this way so somebody can't come along and set no_delete off after an Accessor has been instantiated or defined.

Now we come to the real Moosey part, how to set up the 'retrieve_only' so that Create, Update and Delete are set to 1 (true) and Retrieve is set to 0 (false). Well with Moose have a very neat way to do that, we play with the BUILD arguments before the Class is built with the 'around BUILDARGS' call.

So if I add in this


around BUILDARGS => sub {
my $orig = shift;
my $class = shift;
my $ops = shift(@_);
if ($ops->{retrieve_only}){
$ops->{no_create} = 1;
$ops->{no_retrieve} = 0;
$ops->{no_update} = 1;
$ops->{no_delete} = 1;
}
return $class->$orig($ops);
};

So lets have a quick expiation of the above. First this happens, as I said earlier, before the BUILD is called and we can get three items off the '@_'. First the Original class ($org) which in this case would be a code reference to the calling code, next the Class we are trying to create ($class) in this case 'Database::Accessor' and finally the remaining options that are coming in on '@_'. In this case I shifted these into $opt to be easier to handle.

Now I just do a check to see if 'retrieve_only' is one of the passed in options. In this case I know it will be 0 or 1 as I have the type of that option set to 'Bool' so no need to check if if is equal to '1'. If it is '1' then I change the $ops hash-ref to the value set I want, overriding any that are present. Finally, I just pass that new $ops along to the BUILDER with the $class->$orig() call

Well not many attributes added today but at least I have something new to test and I can do that easily by adding in this


--my $da = Database::Accessor->new({view=>{name=>'test'}});
++my $da = Database::Accessor->new({retrieve_only=>1,view=>{name=>'test'}});

and then these ones

ok($da->no_create() ==1,"Cannot Create");
ok($da->no_retrieve() == 0,"Can Retrieve");
ok($da->no_update() ==1,"Cannot Update");
ok($da->no_delete() ==1,"Cannot Delete");

ok 30 - Cannot Create ok 31 - Can Retrieve ok 32 - Cannot Update ok 33 - Cannot Delete

Cool

6SNZ8SN.jpg

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