所以我正在生成一個子例程，它接受一個謂詞，隱式創建要在該謂詞中使用的$aand$b變數。不幸的是，當我開始使用類并間接呼叫該子例程時，事情并沒有按計劃進行。
我確定原因是謂詞是在與間接子例程呼叫不同的包中生成的，因此caller與謂詞的包范圍不同。
這是我所指的示例：
use strict;
use warnings;
sub find(&$\@) {
my ($pred, $find, $list) = @_;
my $caller = caller;
no strict q"refs";
local *{ "${caller}::a" } = \$find;
for my $i (0..$#$list) {
local *{ "${caller}::b" } = \$list->[$i];
return $i if $pred->();
}
return -1;
}
sub indirectFind(&$\@) {
my ($pred, $find, $list) = @_;
return find(\&$pred, $find, @$list);
}
package foo;
sub new {
my ($class) = @_;
my $self = [ 1, 2, 3 ];
bless $self, $class;
return $self;
}
sub find {
my ($self, $find) = @_;
return main::find { $a == $b } $find, @$self;
}
sub indirectFind {
my ($self, $find) = @_;
return main::indirectFind { $a == $b } $find, @$self;
}
package main;
my $foo = foo->new;
print find { $a == $b } 1, @$foo; # works
print "\n";
print $foo->find(1)."\n"; # works
print $foo->indirectFind(1)."\n"; # does not work
無論呼叫是否是間接的，我如何才能使其正常作業？
uj5u.com熱心網友回復：
您可以使用代碼參考獲取關聯的包
use B qw( svref_2object );
my $pkg = svref_2object( $pred )->STASH->NAME;
所以，
use B qw( svref_2object );
sub find(&$@) {
my $pred = shift;
my $find = shift;
my $pkg = svref_2object( $pred )->STASH->NAME;
my $ap = do { no strict 'refs'; \*{$pkg.'::a'} }; local *$ap = \$find;
my $bp = do { no strict 'refs'; \*{$pkg.'::b'} }; local *$bp;
for my $i ( 0 .. $#_ ) {
*$bp = \( $_[ $i ] );
return $i if $pred->();
}
return -1;
}
uj5u.com熱心網友回復：
訣竅是獲取正在呼叫的函式的包名，以便可以將變數$a和$b注入到該包中。
替換原來的find子程式：
# use Sub::Util qw( subname ); # less direct way to get package name
use B qw( svref_2object ); # more direct way to get package name
sub find(&$\@) {
my ($pred, $find, $list) = @_;
# get the package that &$pred belongs to
# my ($pkg) = subname($pred) =~ /^(. )::/; # less direct
my $pkg = svref_2object( $pred )->STASH->NAME; # more direct
no strict q"refs";
local *{ "${pkg}::a" } = \$find;
for my $i (0..$#$list) {
local *{ "${pkg}::b" } = \$list->[$i];
return $i if $pred->();
}
return -1;
}
這些電話現在都可以作業了。
package main;
my $foo = foo->new;
print find { $a == $b } 1, @$foo; # works
print "\n";
print $foo->find(1)."\n"; # works
print $foo->indirectFind(1)."\n"; # works
轉載請註明出處，本文鏈接：https://www.uj5u.com/qukuanlian/504240.html
標籤：perl