Moose Perl: "modify multiple methods in all subclasses" - perl

Question

I have a Moose BaseDBModel which has different subclasses mapping to my tables in the database. All the methods in the subclasses are like "get_xxx" or "update_xxx" which refers to the different DB operations.
Now i want to implement a cache system for all these methods, so my idea is "before" all methods named like "get_xxx", I will search the name of the method as key in my memcache pool for value. If i found the value, then I will return the value directly instead of method.
ideally, my code is like this
BaseDBModel
package Speed::Module::BaseDBModel;
use Moose;
sub BUILD {
my $self = shift;
for my $method ($self->meta->get_method_list()){
if($method =~ /^get_/){
$self->meta->add_before_method_modifier($method,sub {
warn $method;
find_value_by_method_name($method);
[return_value_if_found_value]
});
}
}
}
SubClasses Example 1
package Speed::Module::Character;
use Moose;
extends 'Speed::Module::BaseDBModel';
method get_character_by_id {
xxxx
}
Now my problem is that when my program is running, it's repeatedly modify the methods, for example:
restart apache
visit the page which will call get_character_by_id, so I can see one warning message
Codes:
my $db_character = Speed::Module::Character->new(glr => $self->glr);
$character_state = $db_character->get_character_by_id($cid);
Warnings:
get_character_by_id at /Users/dyk/Sites/speed/lib/Speed/Module/BaseDBModel.pm line 60.
but if I refresh the page, I saw 2 warning messages
Warnings:
get_character_by_id at /Users/dyk/Sites/speed/lib/Speed/Module/BaseDBModel.pm line 60.
get_character_by_id at /Users/dyk/Sites/speed/lib/Speed/Module/BaseDBModel.pm line 60.
I am using mod_perl 2.0 with apache, every time i refresh the page, my get_character_by_id method will be modified which I don't want

Answer 1

Isn't your BUILD doing the add_before every time you construct a new instance? I'm not sure that's what you want.
Well, the simple/clunky way would be to set some package-level flag so you only do it once.
Otherwise, I think you want to hook into Moose's own attribute building. Have a look at this: http://www.perlmonks.org/?node_id=948231

Answer 2

The problem is BUILD runs every time your create an object (i.e. after every ->new() call), but add_before_method_modifier adds modifier to class, i.e. to all objects.
Simple solution
Mind, that use calls import function from used package every time. That is the place where you want to add modifiers.
Parent:
package Parent;
use Moose;
sub import {
my ($class) = #_;
foreach my $method ($class->meta->get_method_list) {
if ($method =~ /^get_/) {
$class->meta->add_before_method_modifier($method, sub {
warn $method
});
}
}
}
1;
Child1:
package Child1;
use Moose;
extends 'Parent';
sub get_a { 'a' }
1;
Child2:
package Child2;
use Moose;
extends 'Parent';
sub get_b { 'b' }
1;
So now it works as expected:
$ perl -e 'use Child1; use Child2; Child1->new->get_a; Child2->new->get_b; Child1->new->get_a;'
get_a at Parent.pm line 11.
get_b at Parent.pm line 11.
get_a at Parent.pm line 11.
Cleaner solution
Since you can't be 100% sure import will be called (since you can't be sure use will be used) the more cleaner and straightforward solution is just add something like use My::Getter::Cacher in every derived class.
package My::Getter::Cacher;
sub import {
my $class = [caller]->[0];
# ...
}
In this case every derived class should contain both extends 'Parent' and use My::Getter::Cacher since the first line is about inheritance while the second is about adding before modifier. You may count it a bit redundant, but as I said I believe it's more cleaner and straightforward.
P. S.
Maybe you should give a glance at Memoize module.