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