2

我有一个 Moose BaseDBModel，它有不同的子类映射到我在数据库中的表。子类中的所有方法都像“get_xxx”或“update_xxx”，指的是不同的数据库操作。

现在我想为所有这些方法实现一个缓存系统，所以我的想法是“在”所有名为“get_xxx”的方法之前，我将在我的 memcache 池中搜索方法的名称作为键值。如果我找到了值，那么我将直接返回该值而不是方法。

理想情况下，我的代码是这样的

基础数据库模型

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]
      });
    }
  }
}

子类示例 1

package Speed::Module::Character;
use Moose;

extends 'Speed::Module::BaseDBModel';
method get_character_by_id {
    xxxx
}

现在我的问题是，当我的程序运行时，它会反复修改方法，例如：

  1. 重启阿帕奇

  2. 访问将调用 get_character_by_id 的页面，因此我可以看到一条警告消息

代码：

my $db_character = Speed::Module::Character->new(glr => $self->glr);
$character_state = $db_character->get_character_by_id($cid);

警告：

get_character_by_id at /Users/dyk/Sites/speed/lib/Speed/Module/BaseDBModel.pm line 60.

但是如果我刷新页面，我会看到 2 条警告消息

警告：

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.

我正在使用带有 apache 的 mod_perl 2.0，每次我刷新页面时，我的 get_character_by_id 方法都会被修改，这是我不想要的

4

2 回答 2

0

每次构建新实例时，您的 BUILD 不是都在执行 add_before 吗？我不确定那是你想要的。

好吧，简单/笨重的方法是设置一些包级别的标志，这样你只做一次。

否则，我认为您想与 Moose 自己的属性构建挂钩。看看这个：http ://www.perlmonks.org/?node_id=948231

于 2012-08-15T10:29:35.653 回答
0

问题是BUILD每次创建对象时都会运行（即在每次->new()调用之后），但会向class（即所有 objectsadd_before_method_modifier ）添加修饰符。

简单的解决方案

请注意，每次都从使用过的包中use调用导入函数。那是您要添加修饰符的地方。

家长：

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;

孩子1：

package Child1;

use Moose;
extends 'Parent';

sub get_a { 'a' }

1;

孩子2：

package Child2;

use Moose;
extends 'Parent';

sub get_b { 'b' }

1;

所以现在它按预期工作：

$ 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.

更清洁的解决方案

因为你不能 100% 确定import会被调用（因为你不能确定use会被使用），所以更简洁和直接的解决方案就是use My::Getter::Cacher在每个派生类中添加类似的东西。

package My::Getter::Cacher;

sub import {
    my $class = [caller]->[0];

    # ...
}

在这种情况下，每个派生类都应该包含两者extends 'Parent'，use My::Getter::Cacher因为第一行是关于继承，而第二行是关于添加 before 修饰符。你可能认为它有点多余，但正如我所说，我相信它更干净、更直接。

附言

也许你应该看一下Memoize模块。

于 2014-05-21T08:31:19.243 回答