RE: Socket.pm nonblocking

[ahunter]

I presume you mean forking rather than folking <g>

I've written this sort of program quite a lot in the past - the call you want is select(), which will wait for data to arrive on a filehandle. You can also use IO::Select, but there is a major caveat - whatever you do, do *not* ever use the buffered IO functions, because madness lies that way. All the IO functions except sysread() and syswrite() are buffered. I've always been a bit dubious about what IO::Socket does, too, so I've always stuck with the standard Socket library and done things the hard way. I've actually written a module to deal with all this in a transparent way, and there are others available on CPAN.

The vital bit from that code is:

    # Create the list of filedescriptors to check for activity
    $bits = $bobs = '';
    foreach my $listen (@listeners)
      {
    vec($bits, $listen->{fd}->fileno(), 1) = 1;
      }

    # Do the business
    my ($rout, $wout, $eout);
    my $nfound = select($rout=$bits, $wout='', $eout='', undef);

    # Get our noses rubbed in it
    foreach my $listen (@listeners)
      {
    my $fn = $listen->{fd}->fileno();

        # Check if this filedescriptor has data waiting
    if (vec($rout, $fn, 1))
      {
        # This filedescriptor ($listen) is ready for
            # reading (or has been closed at the remote
            # end)
      }
      }

Hopefully you can decipher that... When you get data on a file descriptor, read one byte using sysread() to avoid blocking. If sysread() returns undef, you have an error, and if it returns 0, you have EOF.

In a chat room environment, it may be useful to have timeouts and things - the Time::HiRes library is useful for this. The last argument to select() is a timeout value, in decimal seconds. Use a function like this (UNTESTED!) to add timeouts:

use Time::HiRes qw/time/; # Code will work without this, but works bet
+ter with
my @timers;

sub addTimeout
  {
    my ($timeout, $callback, $calldata) = @_;

    push @timers, { when => time()+$timeout,
                    callback => $callback
                    calldata => $calldata };
    @timers = sort { $a->{when} <=> $b->{when} } @timers;
  }

And when you come to do the select, you call callbacks and work out the last value for select like so:

$now = time();
while ($timers[0]->{when} <= $now)
  {
    my $timeout = shift @timers;
    &{$timeout->{callback}}($timeout->{calldata});
  }
select($rout=$bits, $wout='', $eout='', $timers[0]->{when}-$now);

If a timer expires, $rout will be empty, and the callback will be called when the select() loop is next entered.

Andrew.

UPDATE: Tidied up the code, as I noticed it was a bit ugly, and not very good perl in places. Added some more helpful comments
UPDATE: Timeouts are useful in this sort of environment, too.