Getting Cocky With Moose

moose-chase.jpg

In my last AD&D post I was playing with MooseX::SetOnce 'trait' on some of my attributes in order to stop modification after the initial set.

This worked fine for the first few runs but quite quickly I had to add in all sorts of code to set default values stuff like this


my $hps=$character->current_hps()||0
So my code was quickly becoming messy and it was much easier to work when I had default values to work with first. So what I really want is set 'default' and then 'set once' and then 'read only' 'trait'.

Well now that I am getting quite confident with 'Moose' I decided why not discombobulate 'SetOnce' and see if I could make it do what I want.

So into the code I went.

Well a quick look inside and I saw that it is, as a suspected, a role (and we all know how much I like these) so on with the 50ยข tour.

So buy using an 'around accessor_metaclass' Ricardo was able to Change the accessor 'metaclass' of my hit_points Attribute by adding in his 'MooseX::SetOnce::Accessor'.

He did this by making a call out to 'Moose::Meta::Class->create_anon_class' to create a new version of his 'MooseX::SetOnce::Accessor' and munged it together with the initial version

So now that my 'hit_points' accessor has Ricardo's traits and now when my 'Accessor' is hit the first time an 'around _inline_set_value' is called and that then forces all subsequent calls to '_inline_set_value' to go though his '_ensure_unset' sub. The '_inline_set_value' is one of the internal Moose methods used by the Accessor class to set the values of an Attribute class.

So this is the heart of the matter, for me at least.



sub _ensure_unset {
  my ($self, $instance) = @_;
  Carp::confess("cannot change value of SetOnce attribute " . $self->name)
    if $self->has_value($instance);
}

So now that I am here how am I going to accomplish what I have set out to do. Well in this sub we get two params $self and $instance. '$self' is my "Class::MOP::Attribute' class that holds all the Meta data for my Attribute and '$instance' is obviously where my instance data is. There isn't really much in the '$instance', just the present value of the 'Attribute' and dump of the '$instance' would give you something like this;


$VAR1 = bless( {
                 'hit_points' => 0
               }, 'RPG::ADD::hit_points' );

I am not going to do a dump of $self as that would go on till Sunday as it has everything but an ACME ANVIL in there.

So what to do now. Fortunately the Class::MOP::Attribute is very well documented and I have spent some time paying about before so I know I can tell if an Attribute has a default with '$self->has_default' so I can check that and then I can get that 'value' with a simple '$self->default'. As the joys of a well documented MOP

Now to get the instance value is a little different I just can't do '$instance->value' and doing $instance->{hit_points} does not make for modular code but we do have 'get_value' on 'Class::MOP::Attribute' and all I have to do is pass in the present 'instance' like this '$self->get_value($instance)'

So my logic will be I first check to see if I have a default, If I do and if this default value is the same as the instance value then nothing has changed so I do not have to crap out and I can just return.

and this is what it looks like;



sub _ensure_unset {
  my ($self, $instance) = @_;
  return 
  	if ($self->has_default and ($self->get_value($instance) eq $self->default()) );
  Carp::confess("cannot change value of SetOnce attribute " . $self->name)
    if $self->has_value($instance);
}

and now with this


has hit_points => (
    is=>'rw',
    isa=>'Str',
     traits => [ qw(SetOnce) ],
    alias => [ qw(HP hp) ],
    default=>0,

);

and I can do this


...
my $pc = $new->creator(...)

print "Default HPs=".$pc->HP."\n";

$pc->build_hps;

print "Initial HP=".$pc->HP."\n";

and get this


Default HPs=0
Initial HP=8

Now I wonder if I should put this up as a patch to 'MooseX::SetOnce' or create my own MooseX?


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