如何在 List::Util 中编写与 sort 或 reduce 具有相同签名的子程序

问题描述

我希望能够像这样使用一个函数：

my @grouped = split_at {
      $a->{time}->strftime("%d-%b-%Y %H") ne 
      $b->{time}->strftime("%d-%b-%Y %H") 
} @files;

where split_at 根据一个函数将一个数组拆分成一个由 arrayrefs 组成的数组，如下所示：

sub split_at(&@) {
# split an array into an arrayrefs based on a function
    my $cb = shift;

    my @input = @_;

    my @retval = ( [  ] );

    $i = 0;
    while ($i <= $#input) {
        push @{$retval[$#retval]},$input[$i];
        $i++;
        if (($i < $#input) && $cb->($input[$i-1],$input[$i])) { push @retval,[] }
    }
    pop @retval unless @{$retval[$#retval]};
    return @retval;
}

现在我只能这样称呼它：

my @grouped = split_at { 
          $_[0]->{time}->strftime("%d-%b-%Y %H") ne 
          $_[1]->{time}->strftime("%d-%b-%Y %H") 
} @files;

其中使用 Time::Piece 按 mtime 小时批处理文件。

我正在尝试找出能够将其称为（简化）的方法：

my @foo = split_at { $a <=> $b } @foo;

类似于 sort 或 List::Util::reduce

我已经检查了在 List::Util::PP 中减少的代码以供参考，但我对它的理解不足以将其移植到我的案例中。

解决方法

您需要做的主要事情是将词法第一个和第二个值的值分配到调用者的命名空间中作为 $a 和 $b。 reduce 使用一个值执行此操作：

#     /- 1
#     |  /-3
#     |  |             /-4 
# 0   |  |             |
local *{"${pkg}::a"} = \$a;
#      \-----------/
#             2

让我们快速看一下：

0. local 覆盖此范围内的全局变量以及临时包含在其中的所有范围。因此，当我们调用回调时，该变量将具有不同的值。请记住，$a 和 $b 是特殊的全局变量。

1. 它使用 glob * 分配到该命名空间中的符号表中，并且它足够聪明，可以在符号表中找到正确的槽。想象一个抽屉，一个抽屉用于标量，一个用于数组，一个用于哈希等等。您可能也见过这种安装 subs 的语法。

2. {""} 语法允许从多个部分和其他变量中构建一个变量名称。例如，我们使用包和变量名称 a 来获取 main::a。这需要关闭 strict 'refs'，否则 perl 会报错，因此代码中有 no strict 'refs' 更高。来自 1 的 * 表示我们使用这个 var 名称作为类型 glob。

3. 这与 1 类似，但这次使用的是标量槽。在这种情况下，我们不必禁用严格引用，因为它只是一个普通字符串，Perl 认为这是安全的。这是告诉解释器变量名结束的语法。比较这两个：

   my $foo,$foo_bar;
   "$foo_bar_baz";    # variable doesn't exist error
   "${foo}_bar_baz";  # prints value of $foo and string _bar_baz
   "${foo_bar}_baz";  # prints value of $foo_bar and string _baz
   

   我们需要它，以便我们不会在包 $a 中获得 pkg 的值。

4. 我们将词法 $a 的引用分配给类型 glob 中的那个槽，从 1 开始。这将是一个标量引用。本质上，我们的变量 $a 现在有另一个名称 $pkg::a。当您说 use Foo 'bar' 时，这类似于将子导入您的命名空间。

查看此内容后，我们可以更新您的代码。

sub split_at(&@) {
    my $cb = shift;
    my @input = @_;

    my @retval = [];

    my $pkg = caller;
    my $max = $#input;

    for my $i (0 .. $max) {
        push @{$retval[$#retval]},$input[$i];
        no strict 'refs';
        local *{"${pkg}::a"} = \$input[$i];
        local *{"${pkg}::b"} = \$input[$i + 1]; # autovivification!
        if (($i < $max) && $cb->()) {
            push @retval,[];
        }
    }
    pop @retval unless @{$retval[$#retval]};
    return @retval;
}


my @files = map { { foo => $_ } } qw/ a a b b c d /;

my @grouped = split_at {
          $a->{foo} ne
          $b->{foo}
} @files;

我已经简化了示例的数据结构。

对于循环的每次迭代，我们都需要 $a 和 $b。因为通过类型 glob 将下一个元素分配给我们正在查看的 $b 会导致自动激活，所以我不得不将您的循环类型更改为计数器并引入一个新变量 $max。我在构建它时遇到了无限循环，因为它不断将 undef 元素放在 @input 的末尾。

除此之外，它几乎是相同的代码。我们不再需要向回调传递参数，我们需要no strict 'refs'。您通常会在尽可能小的范围内关闭 strict。我们还需要获取 caller 的命名空间，以便我们可以将变量放在那里。

您还需要注意一件事。 List::Util::PP sets up $a 和 $b 位于调用者的命名空间中，否则我们可能会导致警告，因此如果您想将此函数放入库中，您可能应该使用它使用的相同代码。>

sub import {
  my $pkg = caller;
 
  # (RT88848) Touch the caller's $a and $b,to avoid the warning of
  #   Name "main::a" used only once: possible typo" warning
  no strict 'refs';
  ${"${pkg}::a"} = ${"${pkg}::a"};
  ${"${pkg}::b"} = ${"${pkg}::b"};
 
  goto &Exporter::import;
}