use strict; use warnings; $| = 1; use IO::Socket; use Net::hostent; my $PORT = 9001; my $server = IO::Socket::INET->new( Proto => 'tcp', LocalPort => $PORT, Listen => 1, ReuseAddr => 1, Blocking=>0 ); die "can't setup server... $!... $@..." unless $server; print "[Server $0 accepting clients]\n"; my $state="STOP"; my $data; my $timer=10; my $seq; my $fifo; while(1) { while (my $client = $server->accept()) { $client->autoflush(1); #non blocking reads on windows my $num = 1; ioctl($client, 0x8004667e, \\$num); #non blocking non unix use Fcntl; fcntl($client, F_SETFL, O_NONBLOCK) or die "can't set non blocking: $!"; my $hostinfo = gethostbyaddr($client->peeraddr); printf "[Connect from %s]\n", $hostinfo ? $hostinfo->name : $client->peerhost; print $client "STATE=$state\n"; if ($state eq 'RUN') { print "flushing the fifo\n"; print $client $fifo; undef $fifo; } while ($client) { $client->recv($data, 1024); if ( $data=~/\n/ ){ $_=$data; print STDOUT $_; next unless /\S/; # blank line if (/STOP|stop/i) { $state='STOP'; } elsif (/RUN|run/i) { $state='RUN'; $seq=0; } } else { print '.'; select(undef, undef, undef, 0.1);#100ms delay if ($state eq 'RUN') { if($timer--<=0) { $timer=10; $data=$seq++.','.int(rand(2**32-1)).','.int(rand(2**32-1)).','.int(rand(2**32-1)).','.int(rand(2**32-1))."\n"; print'#'; if ($client->connected() ) { print $client $data; #send the data } } } #whatever the run state, we need to timeout connections #send null to test connection if ($client->connected() ) { print $client "\0"; } unless ($client->connected() ) { $client->close(); print "lost connection\n"; undef $client; } } } #close $client; } print '?'; #if disconnected but in run mode, get cracking if ($state eq 'RUN') { if($timer--<=0) { $timer=10; $fifo.=$seq++.','.int(rand(2**32-1)).','.int(rand(2**32-1)).','.int(rand(2**32-1)).','.int(rand(2**32-1))."\n"; print '*'; } } select(undef, undef, undef, 0.1);#100ms delay } #