Moose Perl：“修改所有子类中的多个方法”答案

【问题标题】：Moose Perl: "modify multiple methods in all subclasses"Moose Perl：“修改所有子类中的多个方法”
【发布时间】：2012-08-11 14:56:35
【问题描述】：

我有一个 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
}

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

重启apache
访问将调用 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 方法都会被修改，这是我不想要的

【问题讨论】：

标签： perl methods moose method-modifier

【解决方案1】：

你的BUILD不是每次构造一个新实例时都在做add_before吗？我不确定这就是你想要的。

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

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

【讨论】：

那不是我想要的，我只想修改"before"一次

【解决方案2】：

问题是BUILD 在您每次创建对象时运行（即在每次->new() 调用之后），但add_before_method_modifier 将修饰符添加到类，即到所有对象。

简单的解决方案

请注意，use 每次都会从使用的包中调用 import 函数。那就是你要添加修饰符的地方。

家长：

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 修饰符。你可能认为它有点多余，但正如我所说，我相信它更干净、更直接。

P。 S.

也许你应该看看Memoize 模块。

【讨论】：