I have, at last, gotten it all working. It took some tweaking and wasn't all that easy to figure out. My environment is that I do two types of interactions on my IO::Socket::INET. One is a simple command->{one line} response. The other is a multi-line response, but the same basic structure: command->{one line} response->{multiline data ended by a line with just '." on it. Here's the working code:
$server = IO::Socket::INET->new(...) ;
abort("Can't connect to news server: $!") unless $server ;
$socket = IO::Select->new($server) ;
my $linebuffer;
# send a command to the server, 1,2, or 3 are success responses.
## This really can't hang, so we can just go for it [no timeout]
sub command
{ my $cmd = "$_[0]\r\n" ;
print $server $cmd ;
$linebuffer = "" ;
my $resp = getline() ;
return undef if $resp !~ /^[123]/ ;
return $resp ;
}
# return a multi-line response from the server
## We return it a line at a time with timeouts if the server barfs
sub multi
{ my $cmd = $_[0] ;
if ($cmd)
{ return (command($cmd)) ; }
return getline() ;
}
sub getline
{ my @readstatus ;
if ($linebuffer =~ s/(^.*?\n)// )
{ return $1 ; }
while(@readstatus = $socket->can_read(2)
and sysread $server, $linebuffer, 4096, length $linebuffer)
{ next unless $linebuffer =~ s/(^.*?\n)// ;
return $1 ;
}
# if you get here, something went wrong!
warn(@readstatus ? "socket closed\n" : "timeout\n") ;
return undef ;
}
The main program that uses this looks like:
die "command error\n" unless multi("command") ;
while (1)
{ my $line = multi() ;
last if $line =~ /^./ ;
{process the line}
}
One other trickiness is that I couldn't get the timeout to work cleanly -- if something went wrong I had a hard time figuring out whether it was recoverable or not. So, I embedded the entire main program in a child fork and the child fork exits with a non-zero status if timeout happens or the connection is lost or if anything else happens. The parent then re-forks and starts the child over again from the beginning. If the child returns with a 0 status the parent just exits. |