Perl：非阻塞管道-仅获取一条消息

几周前，我问了一个关于非阻塞单亲多子女管道实现的问题，@mob巧妙地回答了这个问题

然而，我注意到，如果一个孩子在退出之前发布了不止一条消息，那么家长只会在稍后阅读时收到第一条消息

示例代码：

use IO::Handle;
use POSIX ':sys_wait_h';
pipe(READER,WRITER);
WRITER->autoflush(1);

sub child_process {
    close READER;  # also a best but optional practice
    srand($$);
    my $id = 0;
        sleep 1 + 5*rand();
        $id++;
        print "Child Pid $$ sending message $id now...\n";
        print WRITER "$id:Child Pid $$ is sending this - Message 1\n";
        print WRITER "$id:Child Pid $$ is sending this - Message 2\n";
        exit 0;
}

if (fork() == 0) {
    child_process();
}

# parent
my ($rin,$rout) = ('');
vec($rin,fileno(READER),1) = 1;
while (1) {
     # non-blocking read on pipe
     my $read_avail = select($rout=$rin, undef, undef, 0.0);
     if ($read_avail < 0) {
         if (!$!{EINTR}) {
             warn "READ ERROR: $read_avail $!\n";
             last;
         }
     } elsif ($read_avail > 0) {
         chomp(my $line = <READER>);
         print "Parent Got $$: '$line'\n";
     } else {
            print STDERR "No input ... do other stuff\n";
     }
     sleep 5;
}
close WRITER;  # now it is safe to do this ...

---

这应该是一个非阻塞读取，所以HomeCome不能在下一次迭代中获取数据？是因为孩子离开了吗？我尝试在父级中执行

while（chomp（my$line=）

，但它会阻塞，这是我无法做到的。

看起来您正在混合缓冲和非缓冲I/O。

（和

readline（READER）

）是缓冲输入操作。第一次在文件句柄上调用

readline

，Perl将尝试从句柄读取多达8K的数据，将大部分数据保存在内存缓冲区中。下次在同一个文件句柄上调用

readline

时，Perl将尝试返回缓冲区中的数据，然后再尝试从文件中读取更多数据。这是为了提高效率

select

是一种针对无缓冲I/O的操作。它告诉您输入是否在文件句柄本身上等待，但看不到数据是否在缓冲区中等待

一个笨拙的替代方法是使用

sysread

或

getc

从管道中提取数据。这很不方便，因为您必须自己将输入拆分成单独的行

... if ($read_avail > 0) {
    my $n = sysread READER, my $lines, 16384;
    chomp($lines);
    my @lines = split /\n/, $lines;
    print "Parent Got $$: '$_'\n" for @lines;
} ...

可能的工作方式是在列表上下文中读取文件句柄

chomp(my @lines = <READER>);
seek READER, 0, 1;

chomp（my@lines=）；
寻找读取器，0，1；

应该从缓冲区和文件句柄中读取所有可用数据，理论上，它将使缓冲区为空，因此下一个

调用类似于无缓冲读取。（seek语句清除filehandle上的EOF条件，以便以后当更多输入到达时可以从filehandle读取）

（ETA:nah，那不起作用。那只会阻塞

读卡器

，直到孩子关闭管道末端）

---

选择的文档中有此警告

警告：不应尝试混合缓冲I/O（如
“
读取
”或带有“
选择
”的
”，POSIX允许的情况除外，
即使如此，也只能在POSIX系统上使用。您必须使用“
sysread
”
相反

每次迭代最多只能读取一行，而不是读取管道上的所有可用数据。也许select（）并不表示此后它就不再可读了。请注意，由于您正在分叉，因此还需要在子进程退出后使用获取子进程（在阻塞模式下，waitpid将等待它退出），这将返回子进程的退出代码

我建议使用事件循环来管理流程之间的管道，因为它和它的助手模块将管理流程分叉和数据交换的所有奇怪细节。下面是使用时可能出现的情况

use strict;
use warnings;
use IO::Async::Loop;
use IO::Async::Channel;
use IO::Async::Routine;

my $channel = IO::Async::Channel->new;

sub child_process {
    my $id = 0;
    sleep 1 + 5*rand();
    $id++;
    print "Child Pid $$ sending message $id now...\n";
    $channel->send(\"$id:Child Pid $$ is sending this - Message 1\n");
    $channel->send(\"$id:Child Pid $$ is sending this - Message 2\n");
}

my $loop = IO::Async::Loop->new;
my $f = $loop->new_future;
my $routine = IO::Async::Routine->new(
  channels_out => [$channel],
  code => \&child_process,
  on_return => sub { my $routine = shift; $f->done(@_) },
  on_die => sub { my $routine = shift; $f->fail(@_) },
);
$loop->add($routine);

$channel->configure(on_recv => sub {
  my ($channel, $ref) = @_;
  print "Parent Got: '$$ref'\n";
});

# wait for Future to complete (process finishes) or fail (process fails to start or dies)
my $exitcode = $f->get;
print "Child exited with exit code $exitcode\n";

请注意，这只是一个用于在进程之间发送数据结构的抽象，也是一个用于设置分支代码通道的抽象（或Windows系统上的线程）。此外，还有一个IO:：Async:：Routine的高级包装器，它可以管理一个fork/thread池，以使用不同的输入多次运行一个子例程，并在父例程中接收返回值。因此，根据您想潜水的深度，您可以使用许多级别。
好的，我似乎看到@Grinnz第一次建议使用定义良好的框架的好处。我以为我需要一辆三轮车，但看起来我正在慢慢地用螺母和螺栓建造一辆宝马

@暴民和@grinnz的建议是正确的。这是缓冲区/与非缓冲区的情况

chomp(my @lines = <READER>);
seek READER, 0, 1;

chomp（my@lines=）；
寻找读取器，0，1；

不起作用。它锁着

这本食谱有效，但我明天将进一步调整/测试（）。到目前为止一切顺利：

use IO::Handle;
use POSIX ':sys_wait_h';
use Symbol qw(qualify_to_ref);
use IO::Select;
pipe(READER,WRITER);
WRITER->autoflush(1);

sub sysreadline(*;$) {
    my($handle, $timeout) = @_;
    $handle = qualify_to_ref($handle, caller( ));
    my $infinitely_patient = (@_ == 1 || $timeout < 0);
    my $start_time = time( );
    my $selector = IO::Select->new( );
    $selector->add($handle);
    my $line = "";
SLEEP:
    until (at_eol($line)) {
        unless ($infinitely_patient) {
            return $line if time( ) > ($start_time + $timeout);
        }
        # sleep only 1 second before checking again
        next SLEEP unless $selector->can_read(1.0);
INPUT_READY:
        while ($selector->can_read(0.0)) {
            my $was_blocking = $handle->blocking(0);
CHAR:       while (sysread($handle, my $nextbyte, 1)) {
                $line .= $nextbyte;
                last CHAR if $nextbyte eq "\n";
            }
            $handle->blocking($was_blocking);
            # if incomplete line, keep trying
            next SLEEP unless at_eol($line);
            last INPUT_READY;
        }
    }
    return $line;
}
sub at_eol($) { $_[0] =~ /\n\z/ }

sub child_process {
    close READER;  # also a best but optional practice
    srand($$);
    my $id = 0;
        sleep 1 + 5*rand();
        $id++;
        print "Child Pid $$ sending message $id now...\n";
        print WRITER "$id:Child Pid $$ is sending this - Message 1\n";
        print WRITER "$id:Child Pid $$ is sending this - Message 2\n";
        exit 0;
}

if (fork() == 0) {
    child_process();
}

# parent
my ($rin,$rout) = ('');
vec($rin,fileno(READER),1) = 1;
while (1) {
     # non-blocking read on pipe
     while ((my $read_avail = select($rout=$rin, undef, undef, 0.0)) !=0) 
     {
        if ($read_avail < 0) {
                 if (!$!{EINTR}) {
                 warn "READ ERROR: $read_avail $!\n";
                last;
                }
        }
        elsif ($read_avail > 0) {
         chomp(my $line = sysreadline(READER));
         print "Parent Got $$: '$line'\n";
         print "END MESSAGE\n";
       }
     }
     print STDERR "input queue empty...\n";
     print "Sleeping main for 5...\n";
     sleep 5;
}
close WRITER;  # now it is safe to do this ...

使用IO:：Handle；
使用POSIX'：sys_wait_h'；
使用符号qw（限定至参考）；
使用IO：：Select；
管道（读写器）；
写入程序->自动刷新（1）；
子系统读取行（*；$）{
我的（$handle，$timeout）=@；
$handle=qualify_to_ref（$handle，caller（））；
我的$infinitely_patient=（@==1| |$timeout<0）；
我的$start_time=time（）；
my$selector=IO:：Select->new（）；
$selector->add（$handle）；
我的$line=“”；
睡眠：
直到（在下线（$line））{
除非（$无限位患者）{
返回$line if time（）>（$start\u time+$timeout）；
}
#再次检查前只需睡眠1秒钟
下次睡眠，除非$selector->can_read（1.0）；
输入准备就绪：
而（$selector->can_read（0.0））{
我的$was_blocking=$handle->blocking（0）；
CHAR:while（sysread（$handle，my$nextbyte，1））{
$line.=$nextbyte；
如果$nextbyte eq“\n”；
}
$handle->blocking（$was\u blocking）；
#如果行不完整，请继续尝试
下次睡觉，除非在下线（$line）；
最后输入_就绪；
}
}
返回$line；
}
下线（$）{$[0]=~/\n\z/}
子子进程{
近距离阅读；#也是一种最佳但可选的做法
srand(元);；
我的$id=0；
睡眠1+5*rand（）；
$id++；
打印“子Pid$$正在发送消息$id…\n”；
打印写入程序“$id:子Pid$$正在发送此消息-消息1\n”；
打印写入程序“$id:子Pid$$正在发送此消息-消息2\n”；
出口0；
}
如果（fork（）==0）{
child_过程（）；
}
#母公司
我的（$rin，$rout）=（“”）；
vec（$rin，文件号（读卡器），1）=1；
而(1){
#非阻塞读取管道
而（（我的$read\u avail=select（$rout=$rin，unde，unde，0.0））！=0）
{
如果（$read\u avail<0）{
如果（！$！{EINTR}）{
警告“读取错误：$READ\u avail$！\n”；
最后；
}
}
elsif（$read\u avail>0）{
chomp（我的$line）
use IO::Handle;
use POSIX ':sys_wait_h';
use Symbol qw(qualify_to_ref);
use IO::Select;
pipe(READER,WRITER);
WRITER->autoflush(1);

sub sysreadline(*;$) {
    my($handle, $timeout) = @_;
    $handle = qualify_to_ref($handle, caller( ));
    my $infinitely_patient = (@_ == 1 || $timeout < 0);
    my $start_time = time( );
    my $selector = IO::Select->new( );
    $selector->add($handle);
    my $line = "";
SLEEP:
    until (at_eol($line)) {
        unless ($infinitely_patient) {
            return $line if time( ) > ($start_time + $timeout);
        }
        # sleep only 1 second before checking again
        next SLEEP unless $selector->can_read(1.0);
INPUT_READY:
        while ($selector->can_read(0.0)) {
            my $was_blocking = $handle->blocking(0);
CHAR:       while (sysread($handle, my $nextbyte, 1)) {
                $line .= $nextbyte;
                last CHAR if $nextbyte eq "\n";
            }
            $handle->blocking($was_blocking);
            # if incomplete line, keep trying
            next SLEEP unless at_eol($line);
            last INPUT_READY;
        }
    }
    return $line;
}
sub at_eol($) { $_[0] =~ /\n\z/ }

sub child_process {
    close READER;  # also a best but optional practice
    srand($$);
    my $id = 0;
        sleep 1 + 5*rand();
        $id++;
        print "Child Pid $$ sending message $id now...\n";
        print WRITER "$id:Child Pid $$ is sending this - Message 1\n";
        print WRITER "$id:Child Pid $$ is sending this - Message 2\n";
        exit 0;
}

if (fork() == 0) {
    child_process();
}

# parent
my ($rin,$rout) = ('');
vec($rin,fileno(READER),1) = 1;
while (1) {
     # non-blocking read on pipe
     while ((my $read_avail = select($rout=$rin, undef, undef, 0.0)) !=0) 
     {
        if ($read_avail < 0) {
                 if (!$!{EINTR}) {
                 warn "READ ERROR: $read_avail $!\n";
                last;
                }
        }
        elsif ($read_avail > 0) {
         chomp(my $line = sysreadline(READER));
         print "Parent Got $$: '$line'\n";
         print "END MESSAGE\n";
       }
     }
     print STDERR "input queue empty...\n";
     print "Sleeping main for 5...\n";
     sleep 5;
}
close WRITER;  # now it is safe to do this ...