perl - 我怎样才能使用模拟的 '$_' 函数自动分配给 'readline'？

Question

Perl 对 readline 有一些特殊处理。函数(以及等效的 <> I/O 运算符)，它处理表达式

while (<HANDLE>)
while (readline(HANDLE))

相当于

while (defined($_ = <HANDLE>))

参见

$ perl -MO=Deparse -e 'f($_) while <>'
f($_) while defined($_ = <ARGV>);      <--- implicitly sets $_
-e syntax OK

但是如果你劫持了 readline，这个自动分配似乎不会发生。功能:

$ perl -MO=Deparse -e 'BEGIN {
> *CORE::GLOBAL::readline = sub { }
> }
> f($_) while <>'
sub BEGIN {
    *CORE::GLOBAL::readline = sub {
    };
}
f($_) while readline(ARGV);            <--- doesn't set $_ !
-e syntax OK

当然，这将使自定义 readline对于许多遗留代码，函数无法正常工作。这段代码的输出是 "foo"使用 BEGIN 块和 "bar"没有它，但我希望它是 "BAR" .

use warnings;
BEGIN { *CORE::GLOBAL::readline = \&uc_readline; }
sub uc_readline {
    my $line = CORE::readline(shift || *ARGV);
    return uc $line if defined $line;
    return;
}
($_, $bar) = ("foo\n", "bar\n");
open X, '<', \$bar;
while (<X>) {
  print $_;           # want and expect to see  "BAR\n"
}

我有什么选择可以劫持 readline函数但仍然得到了正确的处理 while (<...>)成语？将所有内容显式转换为 while (defined($_=<...>)) 是不切实际的在所有遗留代码中。

Answer 1

这是一个相当肮脏的黑客使用重载来检测 bool 上下文，但它似乎可以解决问题。在生产环境中使用此解决方案之前，它当然需要比我提供的更多测试:

use warnings;
BEGIN { *CORE::GLOBAL::readline = \&uc_readline; }
sub uc_readline {
    my $line = CORE::readline(shift || *ARGV);
    return Readline->new(uc $line) if defined $line;
    return;
}

{package Readline;
    sub new {shift; bless [@_]}
    use overload fallback => 1,
        'bool' => sub {defined($_ = $_[0][0])},  # set $_ in bool context
        '""'   => sub {$_[0][0]},
        '+0'   => sub {$_[0][0]};
}

my $bar;
($_, $bar) = ("foo\n", "bar\n");
open X, '<', \$bar;
while (<X>) {
  print $_;           # want and expect to see  "BAR\n"
}

打印:

BAR

这也会使 if (<X>) {...}套装 $_ .不知道有没有办法把魔法限制在只有 while循环。