Perl：在调用者上下文中定义变量

Question

我已经创建了这个简单的子程序。

use List::Util qw(pairmap);

sub pairGroupBy(&@) {
  my($irCode, @iaItems) = @_;

  my %laResult = ();
  pairmap {
    my $lsKey = $irCode->();
    if (!defined($lsKey)) {
      die "Trying to pairGroup by nonexisting key '$lsKey'";
    }
    push @{$laResult{$lsKey}}, $a => $b;
  } @iaItems;

  return %laResult;
}

在子例程从定义它的同一文件中使用之前，它运行良好。当我将它移动到某个包时，变量 $a 和 $b 在 $irCode->() 回调中变得未定义。

我从List::Util source code 了解到，这段代码可以解决问题：

my $caller = caller;
local(*{$caller."::a"}) = \my $a;
local(*{$caller."::b"}) = \my $b;

所以我以这种方式修改了我的子程序：

use List::Util qw(pairmap);

sub pairGroupBy(&@) {
  my($irCode, @iaItems) = @_;

  my $caller = caller;

  my %laResult = ();
  pairmap {

    no strict 'refs';
    local(*{$caller."::a"}) = \$a; # <---- the line 96
    local(*{$caller."::b"}) = \$b;

    my $lsKey = $irCode->();
    if (!defined($lsKey)) {
      die "Trying to pairGroup by nonexisting key '$lsKey'";
    }
    push @{$laResult{$lsKey}}, $a => $b;
  } @iaItems;

  return %laResult;
}

但我需要使用no strict 'refs'; 行（List::Util source code 不使用它）。否则会出现错误提示：

Can't use string ("main::a") as a symbol ref while "strict refs" in use at /home/.../bin/SatFunc.pm line 96.

我的问题是：有没有更好的方法来在调用者的上下文中定义$a 和$b 变量而不使用no strict 'refs';？

我希望我的函数以与pairmap、pairgrep 等相同的方式使用。

编辑： @simbabque 询问了一个示例，如何使用该函数。所以这是一个例子：

my %laHoH = (
  aa => {
    color => 'yellow',
    item => 'sun',
    active => 1
  },
  bb => {
    color => 'blue',
    item => 'sky',
    active => 1
  },
  cc => {
    color => 'green',
    item => 'grass',
    active => 0
  },
  dd => {
    color => 'blue',
    item => 'watter',
    active => 1
  }
);


my %laGrouped = pairGroupBy {
  $b->{color}
} pairgrep {
  $b->{active}
} %laHoH;

函数然后返回这个结构：

{
  'yellow' => [
                'aa',
                {
                  'color' => 'yellow',
                  'item' => 'sun',
                  'active' => 1
                }
              ],
  'blue' => [
              'dd',
              {
                'active' => 1,
                'item' => 'watter',
                'color' => 'blue'
              },
              'bb',
              {
                'color' => 'blue',
                'item' => 'sky',
                'active' => 1
              }
            ]
};

Answer 1

我不确定你为什么会看到这个问题，但我怀疑你想太多了。在 void 上下文中使用 pairmap 似乎是个坏主意。

你不能把你的数组转换成一个哈希然后遍历它吗？

my %iaItemsHash = @iaItams;

while (my ($k, $v) = each %iaItemsHash) {
  my $lsKey = $irCode->();
  if (!defined($lsKey)) {
    die "Trying to pairGroup by nonexisting key '$lsKey'";
  }
  push @{$laResult{$lsKey}}, $k => $v;
}

更新：根据您的评论，我重新阅读了您的原始问题，发现您正在谈论通过 $irCode->() 调用访问变量。

我的解决方案的问题是 $k 和 $v 是词法变量，因此在它们的词法范围之外不可用（这通常被视为一个功能！）解决方案是诉诸良好的编程练习并将值作为参数发送到子程序中。

Answer 2

有没有更好的方法来在调用者的上下文中定义$a 和$b 变量而不使用no strict 'refs';?

您问我们如何执行符号取消引用，同时要求 Perl 阻止您进行符号引用。没有理由这样做。如果你想执行符号解引用，不要让 Perl 阻止你这样做。

即使 Perl 没有发现你这样做（即，如果你设法找到不触发 use strict qw( refs ); 的方法），你仍然会使用符号取消引用！你只会对自己和你的读者撒谎。

相反，最好记录下您在做什么。使用no strict qw( refs ); 表示您正在使用use strict qw( refs ); 做某事被假定阻止。

---

以下用于构建与您的代码相同结构的方法更少浪费：

my %laGrouped;
for my $key (keys(%laHoH)) {
   my $rec = $laHoH{$key};
   next if !$rec->{active};
   push @{ $laGrouped{ $rec->{color} } }, $key, $rec;
}

但让我们也改进一下结构。以下方法产生了一个更易于使用的结构：

my %laGrouped;
for my $key (keys(%laHoH)) {
   my $rec = $laHoH{$key};
   next if !$rec->{active};
   $laGrouped{ $rec->{color} }{$key} = $rec;
}

---

如果您发现自己在使用pairGroupBy，那么您可能在某个地方出错了。但是为了教育目的，这里有一个更好的实现：

sub pairGroupBy(&@) {
   my $cb = shift;

   my $caller = caller;
   my $ap = do { no strict 'refs'; \*{ $caller.'::a' } };  local *$ap;
   my $bp = do { no strict 'refs'; \*{ $caller.'::b' } };  local *$bp;

   my %groups;
   while (@_) {
      *$ap = \shift;
      *$bp = \shift;
      my $group = $cb->();
      push @{ $groups{$group} }, $a, $b;
   }

   return %groups;
}