Perl方法调用可以被拦截吗？

Question

你能在 Perl 中拦截一个方法调用，对参数做一些事情，然后执行它吗？

Answer 1

是的，您可以拦截 Perl 子例程调用。我在 Mastering Perl 中有一整章关于此类事情。查看 Hook::LexWrap 模块，它可以让您无需完成所有操作即可完成此操作的细节。 Perl 的方法只是子例程。

您还可以创建一个子类并重写您想要捕获的方法。这是一个稍微好一点的方法，因为这是面向对象编程希望您这样做的方式。然而，有时人们编写的代码不允许您正确执行此操作。 掌握 Perl 中也有更多相关内容。

Answer 2

简单地说，Perl 具有修改符号表的能力。您可以通过方法所属包的符号表来调用子例程（方法）。如果修改符号表（这并不被认为是非常脏的），则可以用调用您指定的其他方法来替换大多数方法调用。这演示了该方法：

# The subroutine we'll interrupt calls to
sub call_me
{
    print shift,"\n";
}

# Intercepting factory
sub aspectate
{
    my $callee = shift;
    my $value = shift;
    return sub { $callee->($value + shift); };
}
my $aspectated_call_me = aspectate \&call_me, 100;

# Rewrite symbol table of main package (lasts to the end of the block).
# Replace "main" with the name of the package (class) you're intercepting
local *main::call_me = $aspectated_call_me;

# Voila!  Prints 105!
call_me(5);

这也表明，一旦有人引用子例程并通过引用调用它，您就无法再影响此类调用。

我非常确定有框架可以在 perl 中进行方面分析，但我希望这可以演示该方法。

Answer 3

这看起来像是 Moose 的工作！ Moose 是 Perl 的一个对象系统，可以做到这一点以及更多。 文档 在解释方面会比我做得更好，但是什么您可能需要一个 方法修饰符，特别是之前。

Answer 4

您可以，并且帕维尔描述了一种很好的方法，但您可能应该首先详细说明为什么要这样做。

如果您正在寻找拦截对任意子例程的调用的高级方法，那么摆弄符号表将适合您，但如果您想向可能导出到您当前正在使用的命名空间的函数添加功能，那么您可能需要了解调用其他名称空间中存在的函数的方法。

例如，Data::Dumper 通常将函数“Dumper”导出到调用命名空间，但您可以覆盖或禁用该函数并提供您自己的 Dumper 函数，该函数然后通过完全限定名称调用原始函数。

例如

use Data::Dumper;

sub Dumper {
   warn 'Dumping variables';
   print Data::Dumper::Dumper(@_);
}

my $foo = {
   bar   => 'barval',
};

Dumper($foo);

，这又是一个替代解决方案，根据原始问题，它可能更合适。使用符号表可以带来很多乐趣，但它可能有点过头了，并且如果您不需要它，可能会导致代码难以维护。

Answer 5

是的。

您需要三件事：

调用的参数位于 @_ 中，这只是另一个动态作用域变量。

然后，goto 支持引用子参数，该参数保留当前的@_ 但进行另一个（尾部）函数调用。

最后，local 可用于创建词法作用域的全局变量，并且符号表隐藏在 %:: 中。

所以你已经得到了：

sub foo {
    my($x,$y)=(@_);
    print "$x / $y = " . ((0.0+$x)/$y)."\n";
}
sub doit {
    foo(3,4);
}
doit();

当然会打印出：

3 / 4 = 0.75

我们可以使用 local 替换 foo 并执行：

my $oldfoo = \&foo;
local *foo = sub { (@_)=($_[1], $_[0]); goto $oldfoo; };
doit();

现在我们得到：

4 / 3 = 1.33333333333333

如果你想修改 *foo 而不使用它的name，并且你不想使用eval，那么你可以通过操作%::来修改它，例如：

$::{"foo"} = sub { (@_)=($_[0], 1); goto $oldfoo; };
doit();

现在我们得到：

3 / 1 = 3