>If Barry could provide a small, self contained script
>that demonstrates the problem it might be a lot easier to see.
Brian makes a good point (because flushing STDOUT did not work, but I enjoyed
learning about it). I wanted to avoid wasting bandwidth with a snippet, because
the snippet is rather large.
To set this up, I'm posting the portion of a loop that listens on port 80, then
forks a process to handle that connection. I post this because it may be
relevant. P.S. there is a bunch of socket setup code that is missing, but this
is a really common method that I used almost verbatim out of a book.
The problem occurs in the subroutine (below) named client_chat. Any "print"
statements in that routine must go to STDERR or they are not seen until *main
process* (not child) terminates. Please be gentle; I'm rather new to Perl so
the code may be amateurish, but I just love the language.
$nfound = select($sout = $sin, undef, undef, .25);
if (vec($sout, fileno(SERVER), 1))
{
$client_addr = accept(CLIENT, SERVER);
($client_socket, $client_pip) = sockaddr_in($client_addr);
if ($client_pip)
{
$client_ip = inet_ntoa($client_pip);
if ($client_pip)
{
unless (defined($kidpid = fork()))
{
print "failed to fork after client connect: $!";
next;
}
if ($kidpid)
{
# If we were forking successful, just 'fire and forget'.
$SIG{$kidpid} = 'IGNORE';
close(CLIENT);
}
else
{
close(SERVER);
client_chat();
close(CLIENT);
exit;
}
}
}
}
sub client_chat
{
# Set up bitmask for client.
$cin = ''; vec($cin, fileno(CLIENT), 1) = 1;
# Check to see if data is ready, and if so, read it.
# Do this until the timeout is reached, or we see two
# CRLF's in a row.
$loopstart = time(); $bufend = 0;
$bufr = ''; @bufr = (); $useragent = '';
for (;;)
{
$nfound = select($cout = $cin, undef, undef, .01);
if (vec($cout, fileno(CLIENT), 1))
{
$rec = recv(CLIENT, $dread, 8192, 0);
$dread =~ s/\x0+//g;
$bufr .= $dread;
if ($bufr =~ /\r\n\r\n$/m) {$bufend = 1; last;}
$loopstart = time();
}
if (time() - $loopstart >= $ctimeout)
{
print STDERR "timeout reached while waiting for client input";
last;
}
}
_______________________________________________
ActivePerl mailing list
[email protected]
To unsubscribe: http://listserv.ActiveState.com/mailman/mysubs
