11

コード参照を取り込んでそのコードを一部のデータに適用する高階ユーティリティ関数がいくつかあります。これらの関数の一部は、サブルーチンの実行中に変数をローカライズする必要があります。最初は、この関数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)
    };

だから私の究極の質問は、これがこの状況で発信者のパッケージを決定する最良の方法であるかどうかです。私が考えていなかった他の方法はありますか？現在のソリューションで発生するのを待っているバグはありますか？

4

2 に答える 2

5

まず、以下を使用でき、変更は必要ありません。

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(...), ...)

すべてを修正するわけではありませんが、$aandの代わりに引数を使用しないと不可能$bです。

于 2011-07-12T17:17:55.743 に答える
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));

元の質問のコンテキストで。

于 2011-09-12T21:34:47.847 に答える