Trong Perl, cách đáng tin cậy nhất để xác định gói của coderef là gì?

Question

Tôi có một số hàm tiện ích bậc cao hơn tham chiếu mã và áp dụng mã đó cho một số dữ liệu. Một số hàm này yêu cầu bản địa hóa các biến trong khi thực hiện các chương trình con. Lúc đầu, tôi đã sử dụng caller để xác định gói để bản địa hoá vào, một cách tương tự như trong ví dụ này reduce chức năng:

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 
} 

Ban đầu kỹ thuật này làm việc tốt, tuy nhiên ngay sau khi tôi cố gắng viết một wrapper chức năng xung quanh chức năng thứ tự cao hơn, tìm ra người gọi chính xác trở nên phức tạp.

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

Bây giờ để cho reduce để làm việc, tôi sẽ cần một cái gì đó như:

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

Tại thời điểm này nó đã trở thành một vấn đề mà gói để bỏ qua, kết hợp với kỷ luật không bao giờ sử dụng chức năng từ bên trong những gói đó. Phải có một cách tốt hơn.

Nó chỉ ra rằng chương trình con các hàm bậc cao hơn lấy làm đối số chứa đủ siêu dữ liệu để giải quyết vấn đề. Giải pháp hiện tại của tôi là sử dụng mô-đun intropection B để xác định việc biên dịch stash của chương trình con được truyền vào trong chương trình con. Bằng cách đó, không có vấn đề gì xảy ra giữa việc biên dịch mã và thực thi của nó, hàm bậc cao hơn luôn biết gói chính xác để bản địa hóa thành.

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

Vì vậy, câu hỏi cuối cùng của tôi là nếu đây là cách tốt nhất để xác định gói của người gọi trong tình huống này? Có cách nào khác mà tôi không nghĩ đến? Có một số lỗi đang chờ xảy ra với giải pháp hiện tại của tôi không?

Answer 1

Trước tiên, bạn có thể sử dụng sau và không cần bất kỳ thay đổi:

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

Nhưng nói chung, sau đây thực sự là chính xác những gì bạn muốn:

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

Bạn muốn $a và $b các biến số của __PACKAGE__ của phụ, vì vậy bạn muốn biết số phụ của __PACKAGE__ và đó chính là điều trả về. Nó thậm chí sửa chữa những điều sau đây:

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

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

Nó không sửa chữa tất cả mọi thứ, nhưng điều đó là không thể mà không sử dụng lập luận thay vì $a và $b.

Answer 2

Trong trường hợp bất cứ ai cần họ, đây là những chức năng mà tôi cuối cùng đã quyết định sử dụng:

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

nào sẽ được sử dụng như:

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

trong bối cảnh của câu hỏi ban đầu.