Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl: the Markov chain saw

RE: nonblocking

by ahunter (Monk)
on Jun 10, 2000 at 20:23 UTC ( #17515=note: print w/replies, xml ) Need Help??

in reply to nonblocking

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.


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.

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://17515]
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others browsing the Monastery: (5)
As of 2017-06-26 02:52 GMT
Find Nodes?
    Voting Booth?
    How many monitors do you use while coding?

    Results (572 votes). Check out past polls.