my ($block_size) = 10_000_000;       # 10MB block size
     my ($timeout) = 0;     # Don't wait.
     my ($rfd)     = '';    # Initialize with string only

     # SYNOPSIS:
     open ($filehandle, "FILE or PIPE");
     CheckHandle ($filehandle);

     sub CheckHandle
     {
          my ($filehandle) = @_;
          vec ($rfd, fileno($filehandle), 1) = 1;

          # Wait for something to happen, and make sure
          # that it happened to the right filehandle.
          if (select ($rfd, undef, undef, $timeout) >= 0
                && vec($rfd, fileno($filehandle), 1))
          {
                 # Something came in!
                 my ($buffer);
                 read ($filehandle, $buffer, $block_size);

                 return $buffer;
          }

          return;
     }
[download]

You set $timeout to 0, this will cause select to block until it can read, it doesn't set select to nonblocking like you sugested. You can set $timeout to 1 and then select will wait up to 1 second to see if anything comes in, and then will continue on with the next line of code. But, this will slow down your program as it will wait up to 1 second each time your loop is run.

Read the warning at the end of select for why mixing select and read is a very bad idea.

Use sysread and syswrite. Really.

use Fcntl;

sysopen(MODEM, "/dev/cua0", O_NONBLOCK|O_RDWR)
    or die "Can't open modem: $!\n";
[download]

--
Hope this helps -- my OS doesn't have any of this fancy blocking or nonblocking hoo-hah, so I can't test properly ;-)

But this is only for files, right? Not processes... =)

--
I am a manual signature virus. Copy me please!

use Fcntl;

my $flags;
fcntl(FILEHANDLE, F_GETFL, $flags) || die $!; # Get the current flags 
+on the filehandle
$flags |= O_NONBLOCK; # Add non-blocking to the flags
fcntl(FILEHANDLE, F_SETFL, $flags) || die $!; # Set the flags on the f
+ilehandle
[download]

This seems to work. (so far =)
It is also quite nifty. I like it.

--
I am a manual signature virus. Copy me please!

my $flags = 0; works for me

Celebrate Intellectual Diversity

Perl does not have a reliable threading model. You cannot rely on this for production level code.

Your color select sucks when viewed with my color scheme. Please don't use color.

The "Blocking?" field should be "Yes" for all seven items (even the ones you have marked as "No"). Under "Buffering?", the two "No (?)"s should be "Yes"s.

        - tye (but my friends call me "Tye")

Pretty much everything you have there is buffered in some way or another. Don't forget that you can turn this off using $. It's also worth mentioning that's its a bad idea to use send or recv on a filehandle. :-D For syswrite and sysread, buffering is also optional.


AgentM Systems nor Nasca Enterprises nor Bone::Easy nor Macperl is responsible for the comments made by AgentM. Remember, you can build any logical system with NOR.

sysread and syswrite are not buffered, other than that the operating system might buffer things such that what you syswrite() might not be flushed to disk immediately. But it will be visible to other processes immediately.

        - tye (but my friends call me "Tye")

# An non-blocking filehandle read that returns an array of lines read
# Returns:  ($eof,@lines)
my %nonblockGetLines_last;
sub nonblockGetLines {
  my ($fh,$timeout) = @_;

  $timeout = 0 unless defined $timeout;
  my $rfd = '';
  $nonblockGetLines_last{$fh} = ''
        unless defined $nonblockGetLines_last{$fh};

  vec($rfd,fileno($fh),1) = 1;
  return unless select($rfd, undef, undef, $timeout)>=0;
    # I'm not sure the following is necessary?
  return unless vec($rfd,fileno($fh),1);
  my $buf = '';
  my $n = sysread($fh,$buf,1024*1024);
  # If we're done, make sure to send the last unfinished line
  return (1,$nonblockGetLines_last{$fh}) unless $n;
    # Prepend the last unfinished line
  $buf = $nonblockGetLines_last{$fh}.$buf;
    # And save any newly unfinished lines
  $nonblockGetLines_last{$fh} =
        (substr($buf,-1) !~ /[\r\n]/ && $buf =~ s/([^\r\n]*)$//)
            ? $1 : '';
  $buf ? (0,split(/\n/,$buf)) : (0);
}
[download]

$fh = new IO::File;
open($fh,"$cmd 2>&1 |");

do {
    ($eof,@lines) = nonblockGetLines($fh);
    foreach my $line ( @lines ) {
        print "Pipe saw:  [$line]\n";
    }
} until $eof;

close $fh;
[download]

> # I'm not sure the following is necessary?
> return unless vec($rfd,fileno($fh),1);


select() allows you to check for many file descriptors at once by adding each fd into the $rfd vector. The $rfd gets modified by select() to let you know which file descriptors are available.

The second line of code here verifies that the file descriptor you asked about is one that's ready.