In Perl, what is the most reliable way to determine a coderef's package?

Question

I have a number of higher order utility functions that take in a code reference and apply that code to some data. Some of these functions require localizing variables during the execution of the subroutines. At the beginning, I was using caller to determine which package to localize into, in a similar manner as shown in this example reduce function:

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
}

Initially this technique worked fine, however as soon as I tried writing a wrapper function around the higher order function, figuring out the correct caller becomes complicated.

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

Now in order for reduce to work, I would need something like:

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

At this point it became a question of which packages to skip, combined with the discipline of never using the function from within those packages. There had to be a better way.

It turns out that the subroutine the higher order functions take as an argument contains enough meta-data to solve the problem. My current solution is using the B introspection module to determine the compiling stash of the passed in subroutine. That way, no-matter what happens between compilation of the code and its execution, the higher order function always knows the correct package to localize into.

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

So my ultimate question is if this is the best way of determining the caller's package in this situation? Is there some other way that I have not thought of? Is there some bug waiting to happen with my current solution?

Answer 1

First, you can use the following and not need any changes:

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

But generally speaking, the following is indeed exactly what you want:

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

You want the $a and $b variables of the sub's __PACKAGE__, so you want to know the sub's __PACKAGE__, and that's exactly what that returns. It even fixes the following:

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

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

It doesn't fix everything, but that's impossible without using arguments instead of $a and $b.

Answer 2

In case anyone needs them, here are the functions that I eventually decided to use:

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

Which would be used as:

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

in the context of the original question.