You can work around it with a select loop. The trick is that although the socket is still blocking it only *actually blocks* if you *actually try to read from it when there is no data*. By using vec and the 4 arg select as shown you can check for data before you go for a blocking read. If there is actual data there it won't actually block, so it is *effectively non blocking* rather than actually non blocking.
Here is a sample server. Note that because there is vitually no delay between the socket being readable and actually reading it you will only get 1 byte of data as sysread is not buffering. You can do this with the IO::Select can_read() method if you want the OO interface.
use Socket;
$host = pack('C4', 127,0,0,1);
$port = 8888;
$proto = 6; # TCP
$queueSize = 5; # Queue up to 5 connections
$pollTime = 0.5; # polling time
$delay = 0.5; # slow the select loop down for example
socket( SOCK, AF_INET, SOCK_STREAM, $proto );
$address = pack('S n a4 x8', AF_INET, $port, $host);
bind(SOCK, $address);
listen(SOCK, $queueSize);
print STDOUT "Server host: ",join('.',unpack('C4', $host)),"\n";
print STDOUT "Server port: $port\n";
$cAddress = accept(NEWSOCK,SOCK);
($cDomain, $cPort, $cHost) = unpack('S n a4 x8', $cAddress);
print STDOUT "Client host: ",join('.',unpack('C4', $cHost)),"\n";
print STDOUT "Client port: $cPort\n";
select(NEWSOCK); $| = 1; select(STDOUT);
print NEWSOCK "Welcome to Reverse Echo Server.\r\n";
vec($bits1,fileno(NEWSOCK),1)=1;
while(1) {
$rc=select($rout1=$bits1,$wout1=$bits1,$eout1=$bits1,$pollTime);
+# poll
print "$rc=select($rout1,$wout1,$eout1)\n";
if ( vec($rout1,fileno(NEWSOCK),1) ) {
sysread( NEWSOCK, $buf, 1 );
print "Got $buf\n";
}
select(undef,undef,undef,$delay); # this is not a select, it is a
+ sleep!
}
close(NEWSOCK);
close(SOCK);
exit;
__DATA__
# telnet localhost 8888
Welcome to Reverse Echo Server.
Hello
# server
C:\>server.pl
Server host: 127.0.0.1
Server port: 8888
Client host: 127.0.0.1
Client port: 3432
1=select( ,?, )
1=select( ,?, )
1=select( ,?, )
Got H
2=select(?,?, )
Got e
2=select(?,?, )
Got l
2=select(?,?, )
Got l
2=select(?,?, )
Got o
1=select( ,?, )
1=select( ,?, )
1=select( ,?, )
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.