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

Question

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

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

哪里 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供引用，但我对它的理解不足以将其移植到我的案例中。

Answer 1

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

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

让我们快速看一下:

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

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

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

这类似于 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 .

我们为我们的词法 $a 分配一个引用从 1 到类型 glob 中的那个插槽。这将是一个标量引用。本质上是变量 $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对于循环的每次迭代。因为将下一个元素分配给我们正在查看的元素 $b通过类型 glob 导致自动激活我不得不将循环类型更改为计数器并引入一个新变量 $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;
}