Atanmış bir 'readline' işleviyle otomatik olarak '$ _' a nasıl atayabilirim?

Question

Perl,

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

karş ifadeleri eşdeğer olarak

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

davranır readline fonksiyonu için bazı özel işleme (ve buna denk <> I/O operatörü) sahip olan

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

Ama readline fonksiyonunu kaçırmak eğer bu otomatik atama gerçekleşmesi görünmüyor:

$ 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 

Tabii ki, bu eski kod bir sürü için yanlış özel readline fonksiyon çalışmalarını yapacaktır. Bu kod BEGIN bloğu ve "bar" olmadan bu kod "foo" ise, ancak "BAR" olmasını istiyorum.

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" 
} 

seçeneklerim nelerdir readline fonksiyonunu kaçırmak ama yine while (<...>) deyim uygun tedavi almak gerekiyor? Tüm eski kodlarda her şeyi açıkça while (defined($_=<...>))'a dönüştürmek pratik değildir.

Answer 1

Bu, boole içeriğini algılamak için aşırı yüklemeyi kullanan oldukça kirli bir saldırıdır, ancak hile yapmak gibi görünüyor.

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" 
} 

yazdırır:

BAR 

Bu aynı zamanda if (<X>) {...}$_ set yapacak Kesinlikle ben bir üretim ortamında bu çözümü kullanmadan önce onu verdik daha test ihtiyacı var. Büyüyü sadece while döngülerle sınırlamanın bir yolu olup olmadığını bilmiyorum.

Answer 2

Bu kod:

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

neredeyse doğru olanı yapar, ancak döngü sonra, $ _ dosya tanıtıcısından okunan son değere ayarlanır böylece _, lokalize değildir $.

use warnings; 
use Scope::Upper qw/localize SCOPE/; 
BEGIN { *CORE::GLOBAL::readline = \&uc_readline; } 
sub uc_readline { 
    my $line = CORE::readline(shift || *ARGV); 
    return unless defined $line; 
    $line = uc $line; 
    local $_ = $line; 
    # localize $_ in the scope of the while 
    localize *main::_, \$line, SCOPE(1); 
    return $line; 
} 
($_, $bar) = ("foo\n", "bar\n"); 
open X, '<', \$bar; 
while (<X>) { 
    print "$_";   # want and expect to see "BAR\n" 
} 
print "$_";    # will print 'foo', not "BAR"