在Perl中,确定coderef包的最可靠方法是什么?

时间:2011-07-12 15:08:39

标签: perl higher-order-functions

我有许多高阶实用程序函数,它们接受代码引用并将该代码应用于某些数据。其中一些函数需要在执行子例程期间本地化变量。开始时,我使用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内省模块来确定传​​入的子例程的编译存储。这样,无论在编译代码和执行代码之间发生了什么,高阶函数总是知道正确的本地化包。

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

所以我的最终问题是,在这种情况下,这是否是确定来电者套餐的最佳方式?还有其他一些我没有想过的方法吗?我当前的解决方案是否有一些错误等待发生?

2 个答案:

答案 0 :(得分:5)

首先,您可以使用以下内容而无需任何更改:

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

但总的来说,以下确实是你想要的:

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

您需要子$a的{​​{1}}和$b变量,因此您想知道子__PACKAGE__,这正是返回的内容。它甚至修复了以下内容:

__PACKAGE__

它并不能解决所有问题,但如果不使用参数而不是{ package Utils; sub mk_some_reducer { ... return sub { ... $a ... $b ... }; } } reduce(mk_some_reducer(...), ...) $a,这是不可能的。

答案 1 :(得分:1)

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

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

在原始问题的背景下。