如何在Perl中访问monkeypatched方法的原始方法？

我试图修补一个Perl类:我想改变现有方法的行为.

perlmonks上的此节点显示如何将函数添加到现有类.我发现这个模式也可以用来为现有函数提供一个新的实现.

但是,我想知道如何调用原始函数.

我正在寻找这样的东西:

use ExistingClass;

# TODO: Somehow rename existingFunction() to oldExistingFunction().

sub ExistingClass::existingFunction {
    my $self = shift;

    # New behavior goes here.
    $self->oldExistingFunction(@_); # Call old behavior.
    # More new behavior here.
}

JB... 10

Typeglob分配

*ExistingClass::oldExistingFunction = *ExistingClass::existingFunction;

又脏又脏.这将所有existingFunction符号别名化为oldExistingFunction.这包括您感兴趣的子,以及可能碰巧具有相同名称的任何标量,数组,哈希,句柄.

优点:没有思考,它只是有效."快"

缺点:"脏"

Coderef赋值

*ExistingClass::oldExistingFunction = \&ExistingClass::existingFunction;
# or something using *ExistingClass::symbol{CODE}

那只是别名的子.它仍然在软件包存储中完成,因此oldExistingFunction符号是全局可见的,可能是也可能不是你想要的.可能不是.

优点:别名不会"泄漏"到其他变量类型.

缺点:思考更多,打字更多.如果使用*... {CODE}语法(我个人每天都不使用它),还有更多的想法

词典coderef

my $oldFunction = \&ExistingClass::existingFunction;

使用my保留对仅对currrent块/文件可见的旧函数的引用.没有你的帮助,外部代码无法掌握它.注意召唤大会:

$self->$oldFunction(@args);
$oldFunction->($self, @args);

优点:不再有可见性问题

缺点:难以做到正确

驼鹿

见jrockway的回答.它必须是正确的方式,因为不再有整合和/或引用,但我不知道解释它.

Typeglob分配

*ExistingClass::oldExistingFunction = *ExistingClass::existingFunction;

又脏又脏.这将所有existingFunction符号别名化为oldExistingFunction.这包括您感兴趣的子,以及可能碰巧具有相同名称的任何标量,数组,哈希,句柄.

优点:没有思考,它只是有效."快"

缺点:"脏"

Coderef赋值

*ExistingClass::oldExistingFunction = \&ExistingClass::existingFunction;
# or something using *ExistingClass::symbol{CODE}

那只是别名的子.它仍然在软件包存储中完成,因此oldExistingFunction符号是全局可见的,可能是也可能不是你想要的.可能不是.

优点:别名不会"泄漏"到其他变量类型.

缺点:思考更多,打字更多.如果使用*... {CODE}语法(我个人每天都不使用它),还有更多的想法

词典coderef

my $oldFunction = \&ExistingClass::existingFunction;

使用my保留对仅对currrent块/文件可见的旧函数的引用.没有你的帮助,外部代码无法掌握它.注意召唤大会:

$self->$oldFunction(@args);
$oldFunction->($self, @args);

优点:不再有可见性问题

缺点:难以做到正确

驼鹿

见jrockway的回答.它必须是正确的方式,因为不再有整合和/或引用,但我不知道解释它.

您应该使用Moose或Class :: Method :: Modifiers.

在这种情况下,你可以说:

around 'some_method' => sub {
    my ($orig, $self, @args) = @_;
    # ... before original ...
    $self->$orig(@_);
    # ... after original ...
};