Client:

#!C:/perl/bin/perl -w
use strict;
use warnings;
my $cvs_version = sprintf "%d.%03d", q$Revision: 1.4 $ =~ /(\d+)\.(\d+
+)/;

use IO::Socket;
my ($host, $port, $kidpid, $handle, $line);

unless (@ARGV == 2) { die "usage: $0 host port" }
($host, $port) = @ARGV;

$handle = IO::Socket::INET->new(
        Proto     => "tcp",
        PeerAddr  => $host,
        PeerPort  => $port,
        Timeout   => .1,     # this seems to have no improvement on my
+ problem...
        #Blocking  => 1,     # if this is enabled Perl dies with "Bad 
+file descriptor"
      ) or die "can't connect to port $port on $host: $!";

my $num = 'a';  #just proving that ioctl has infact changed this to un
+def after running...
$num = ioctl($handle, 0x8004667e, 1);   
print "ioctl return code was [$num]\n";
#with or without the ioctl statement, reading from the socket... 
#... eventually blocks if nothing is there to be read...
       
$handle->autoflush(1); 
print STDERR "[Connected to $host:$port]\n";

die "can't fork: $!" unless defined($kidpid = fork());

if ($kidpid) {     # parent copies the socket to standard output
    $| = 1; #set STDOUT to non-buffered to demonstrate that two way...
+ 
            # ...communication is possible up until there is nothing l
+eft to read.
    my $buff;
    while (1){
        my $num = sysread($handle, $buff, 4);   #if there are zero byt
+es waiting, the sysread appears ...
        if ($num >= 4) {                        #... to block, and eve
+n blocks the child thread from writing to $handle...
            print $buff;
        }
        else {
            print "buffer is [$num] bytes big\n";
        }
        sleep 1;
    }
    warn "Read from buffer stopped...\n";
    kill("TERM" => $kidpid);       
}
else {         # child copies standard input to the socket
    while (defined ($line = <STDIN>)) {
        chomp $line;
        warn "echo before send: [$line]\n";
        print $handle "$line\n";
        warn "echo after send: [$line]\n";
    }
}
exit;
[download]

Server:

#!C:/perl/bin/perl -w
use strict;
use warnings;
my $cvs_version = sprintf "%d.%03d", q$Revision: 1.4 $ =~ /(\d+)\.(\d+
+)/;

$| = 1;   
use IO::Socket;
use Net::hostent;        

my $PORT = 9001;            

my $server = IO::Socket::INET->new( Proto     => 'tcp',
                                    LocalPort => $PORT,
                                    Listen    => 1,
                                    ReuseAddr => 1,
                                  ); 
                                    
die "can't setup server... $!... $@..." unless $server;
print "[Server $0 accepting clients]\n"; 

my $num = 'a';
$num = ioctl($server, 0x8004667e, 1);
print "ioctl return code was [$num]\n";  #returns undef

sleep 1;

while (my $client = $server->accept()) {
   $client->autoflush(1);
   
    $num = 'a';
    $num = ioctl($server, 0x8004667e, 1);
    print "ioctl return code was [$num]\n"; #returns undef
   
   print $client "Welcome to $0; type help for command list.\n";
   my $hostinfo = gethostbyaddr($client->peeraddr);
   printf "[Connect from %s]\n", $hostinfo ? $hostinfo->name : $client
+->peerhost;
   
   print $client "Command? \n";
   sleep 1;
   
   while (defined ($_ = <$client>) ){
     print STDOUT $_;
     next unless /\S/;         # blank line
     if    (/quit|exit/i)    { last;                                  
+   }
     elsif (/date|time/i)    { printf $client "%s\n", scalar localtime
+;  }
     elsif (/hello/i )       { print  $client "G'day there\n";        
+   }
     else {
       print $client "Commands: quit date hello\n";
     }
   } continue {
      print $client "Command? \n";
   }
   close $client;
}
[download]