在 Perl 中，确定 coderef 包的最可靠方法是什么？答案

【问题标题】：In Perl, what is the most reliable way to determine a coderef's package?在 Perl 中，确定 coderef 包的最可靠方法是什么？
【发布时间】：2011-07-12 15:08:38
【问题描述】：

我有许多高阶实用程序函数，它们接受代码引用并将该代码应用于某些数据。其中一些函数需要在子例程执行期间本地化变量。一开始，我使用caller 来确定要本地化到哪个包中，方法与此示例中的reduce 函数类似：

sub reduce (&@) {
    my $code      = shift;
    my $caller    = caller;
    my ($ca, $cb) = do {
        no strict 'refs';
        map \*{$caller.'::'.$_} => qw(a b)
    };
    local (*a, *b) = local (*$ca, *$cb);
    $a = shift;
    while (@_) {
        $b = shift;
        $a = $code->()
    }
    $a
}

最初这种技术效果很好，但是一旦我尝试围绕高阶函数编写一个包装函数，找出正确的调用者就变得复杂了。

sub reduce_ref (&$) {&reduce($_[0], @{$_[1]})}

现在为了让reduce 工作，我需要类似的东西：

    my ($ca, $cb) = do {
        my $caller = 0;
        $caller++ while caller($caller) =~ /^This::Package/;
        no strict 'refs';
        map \*{caller($caller).'::'.$_} => qw(a b)
    };

此时，要跳过哪些包，再加上从不使用这些包中的函数的原则，这就变成了一个问题。必须有更好的方法。

事实证明，高阶函数作为参数的子程序包含足够的元数据来解决问题。我目前的解决方案是使用B introspection 模块来确定传入子例程的编译存储。这样，无论在代码编译和执行之间发生什么，高阶函数总是知道要本地化到的正确包。

    my ($ca, $cb) = do {
        require B;
        my $caller = B::svref_2object($code)->STASH->NAME;
        no strict 'refs';
        map \*{$caller.'::'.$_} => qw(a b)
    };

所以我的最终问题是，在这种情况下，这是否是确定调用者包裹的最佳方式？还有其他我没有想到的方法吗？我当前的解决方案是否存在等待发生的错误？

【问题讨论】：

这似乎非常依赖于实现...您有多大把握在未来的 Perl 版本中这些都不会改变？使用对象而不是原始函数，让每个对象存储一个函数并记住相应的包不是更简单、更健壮吗？

标签： perl higher-order-functions

【解决方案1】：

首先，您可以使用以下内容，无需任何更改：

sub reduce_ref (&$) { @_ = ( $_[0], @{$_[1]} ); goto &reduce; }

但总的来说，以下确实正是你想要的：

B::svref_2object($code)->STASH->NAME

您想要 sub 的 __PACKAGE__ 的 $a 和 $b 变量，因此您想知道 sub 的 __PACKAGE__，这正是它返回的内容。它甚至修复了以下问题：

{
   package Utils;
   sub mk_some_reducer {
      ...
      return sub { ... $a ... $b ... };
   }
}

reduce(mk_some_reducer(...), ...)

它不能解决所有问题，但如果不使用参数而不是 $a 和 $b，这是不可能的。

【讨论】：

我知道有人会提到goto &sub 解决方法:) 这是我通常的解决方案，但在这种情况下，真正的包装器要么需要本地化其他变量，要么需要后处理来自霍夫。关于上面Nemo关于->STASH->NAME接口稳定性的评论，你认为假设B接口不会改变是否安全？

【解决方案2】：

如果有人需要，以下是我最终决定使用的功能：

require B;
use Scalar::Util 'reftype';
use Carp 'croak';

my $cv_caller = sub {
    reftype($_[0]) eq 'CODE' or croak "not code: $_[0]";
    B::svref_2object($_[0])->STASH->NAME
};

my $cv_local = sub {
    my $caller = shift->$cv_caller;
    no strict 'refs';
    my @ret = map \*{$caller.'::'.$_} => @_;
    wantarray ? @ret : pop @ret
};

将用作：

my ($ca, $cb) = $code->$cv_local(qw(a b));

在原始问题的上下文中。

【讨论】：