in reply to Re^2: forked kid can't read from IO::Select->can_read
in thread forked kid can't read from IO::Select->can_read

Using regular buffered reads, you don't really have much control over it. Most likely, it will block even if you sent exactly one line, because at the time of the actual (hidden) sysread, it doesn't know that there's a full line available -- it just reads a fixed number of bytes.

So you have two options. One is to do a select and a sysread for every individual byte. This is probably easier but very inefficient.

Another is to change STDIN to be nonblocking, and try to sysread large chunks at a time. Keep trying until sysread returns undef, and then check $!{EWOULDBLOCK}. Completely untested: 

sub read_available {
  my ($fh) = @_;
  my $data = '';
  while (1) {
    my $buf;
    my $nread = sysread($fh, $buf, 4096);
    if (defined $nread) {
      if ($nread == 0) {
        # End of file, so we have everything we'll ever get
        return ($data, 1);
      } else {
        $data .= $buf;
      }
    } else {
      if ($!{EWOULDBLOCK}) {
        return ($data, 0);
      } else {
        return; # Error
      }
    }
  }
}
.
.
.
# Set STDIN nonblocking
IO::Handle->new_from_fd(fileno(STDIN), "r")->blocking(0);
.
.
.
# If select says that STDIN is readable...
my ($data, $eof) = read_available(*STDIN)
  or die "Error reading stdin: $!";

[download]

I really should test this once, but hopefully it gives the right idea. Seems like a correct version of this routine ought to be in a FAQ somewhere. Or maybe it is; I didn't check.

Replies are listed 'Best First'.
Re^4: forked kid can't read from IO::Select->can_read
by Anonymous Monk on May 23, 2005 at 14:47 UTC
    Hi again,

    thank you for your support, in return this code which works for me quite well.

    It migth be a good idea to put that in FAQ, but carfully look for key words as I sometimes do not know for which words to look for!

    Some remarks to this code
    Using the STDIN within the function of the kid I didn't get anything from STDIN. Only this way I was able to get the lines from 'dad'.

    Unblocking the read of course forces you to do a sleep or wait (like my function to wait for full minute) otherwise the kid will heat up the pc ;-). It is a bit self adapting to keep the buffer reasonable small..

    Not to have so many loops in loops in loops, I first push all readables in @LINES and the treat them.

    Who ever wants/will write this FAQ-topic may use/change it.

    Thanks for all
    Carl

      use IO::Handle;
  my ($readPIPE,$writePIPE, $pid);
  pipe $readPIPE, $writePIPE;
  $writePIPE->autoflush(1);
  $pid = fork;

  if ( !$pid ) {   # child
    close($writePIPE);
    nonBlockingRead( $readPIPE );
    exit;
  } else { # parent
      close($readPIPE);
      my (n,$s) = (0,0);
      while (1) {
        $s = (int(rand( 50 )));
        sleep (int(rand( 50 )));
        print $writePIPE "Dad: line ",++$n," after $s s\n";
      }
  }

sub nonBlockingRead {
    use IO::Select;
    my $PIPE = ( shift );
    my $SEL = IO::Select->new( $PIPE );
    my @LINES = qw ( ini deafault array size );
    IO::Handle->new_from_fd(fileno( $PIPE ),"r")->blocking(0);

    while ( $SEL->exists( $PIPE ) ) {
      ($sleep,$send) = doWait( $sleep, scalar @LINES );
      @LINES = ();
      foreach my $h ( $SEL->can_read(0) ) {
        push @LINES, ( <$h> );
      }
      foreach my $l ( @LINES ) {
        &doSomething( $l );
      }
    }
}

sub doWait {
    my $sec = (shift);
    my $NoL = (shift); #: every whole min
    $sec = ($NoL>20)?($sec/2):(($NoL< 5)?($sec+1):$sec);
    my $m = 60 - (time%60);
    if ( ( $m - $sec/2 ) < $sec ) {
      sleep ($m-0.2);
      return ($sec, 1); # ok full Min
    } else {
      sleep ($sec);
      return ($sec, 0); # default
    }
  }

    [download]
[reply]
[d/l]

In Section Seekers of Perl Wisdom