Perlでは、コードレットのパッケージを決定する最も信頼性の高い方法は何ですか？

Question

私は、コード参照を取り込んでそのコードをいくつかのデータに適用するいくつかの高次ユーティリティ関数を持っています。これらの関数の中には、サブルーチンの実行中に変数をローカライズする必要があるものがあります。この例ではreduce機能を示すように、初めに、私は同様の方法で、にローカライズするためにどのパッケージを決定するためにcallerを使用していた。

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 
} 

は、最初は、この技術は、しかし、すぐに私はラッパーを書いてみましたように、うまく働きました高次関数の周りで機能し、正しい発信者が複雑になることを理解する。それは機能を使用したことがないの規律と組み合わせて、スキップするパッケージをの質問になりました。この時点で

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

：

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

は今reduceが動作するためには、私のようなものが必要になりますそれらのパッケージから。より良い方法がなければならなかった。

問題を解決するのに十分なメタデータが引数として取られていることが分かります。私の現在の解決策は、Bイントロスペクションモジュールを使用して、渡されたサブルーチンのコンパイルstashを判断することです。そのようにして、コードのコンパイルとその実行の間に何が起こっても、高次関数は常に正しいパッケージがローカライズされることを知っています。

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

これは、このような状況では、呼び出し側のパッケージを決定するための最良の方法であるのであれば、私の究極の質問はありますか？私が考えていない他の方法がありますか？私の現在のソリューションで起こるのを待っているバグはありますか？

Answer 1

まず、あなたは以下を使用していない任意の変更を必要とすることができます。

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

をしかし、一般的に言えば、次のように正確に何をしたい確かです：

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

あなたが$aと$bをしたいですサブの変数__PACKAGE__があるので、サブの__PACKAGE__を知りたいと思っています。それはそれが返すものです。それも、次のように修正されます。

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

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

それがすべてを解決していませんが、その代わりに$aと$bの引数を使用せずに不可能です。

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

。