Perl:非阻塞管道 - 只收到一条消息 [英] Perl: non blocking pipe - only getting one message

问题描述

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

I had asked a question a few weeks ago about implementation of a non-blocking one parent-many child pipe, which was ably answered by @mob here

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

However, I've noticed that if a child posts more than one message before exiting, the parent only gets the first one if it reads a little later.

示例代码:

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 ...

预期输出:

我应该收到两条消息.

我得到的是:只有第一条消息

What I get: Only the first message

No input ... do other stuff
No input ... do other stuff
Child Pid 8594 sending message 1 now...
Parent Got 8593: '1:Child Pid 8594 is sending this - Message 1'
No input ... do other stuff

这应该是一个非阻塞读取，所以回家它不能在下一次迭代中获取数据?是因为孩子退出了吗?我尝试在父级中执行 while (chomp(my $line = <READER>)) ，但是我无法阻止.

This is supposed to be a non-blocking read, so home come it can't pick up the data on the next iteration? Is it because the child exited? I tried doing a while (chomp(my $line = <READER>)) in the parent, but that blocks, which I can't have.

推荐答案

好的，我似乎看到了@Grinnz 的第一个建议使用定义良好的框架的好处.我以为我需要一辆三轮车，但看起来我正在慢慢地用螺母和螺栓建造一辆宝马.

Ok, I seem to see the benefit of @Grinnz's first recommendation to use a well defined framework. I thought I needed a tricycle but it looks like I'm slowly constructing a BMW from nuts and bolts.

@mob 和@grinnz 的建议是对的.这是一个缓冲/vs/非缓冲的情况.

@mob and @grinnz's suggestions were right. It was a case of buffer/vs/non buffer.

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

不起作用.它锁定.

这本食谱有效，但我明天会进一步调整/测试(来源).到目前为止一切顺利:

This cookbook recipe works, but I'll tweak it/test it further tomorrow (source). So far so good:

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 ...

这篇关于Perl:非阻塞管道 - 只收到一条消息的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！