non-blocking, non-forking, single thread perl tcp server

server.pl

use IO::Socket::INET;
use IO::Select;
use POSIX;

print "starting on $ARGV[0]\n";
$| = 1;
my $select = new IO::Select;
my $socket = new IO::Socket::INET(
	LocalAddr => '0.0.0.0',
	LocalPort => $ARGV[0],
	Listen => 5,
	Blocking => 0,
	Proto => 'tcp',
	Reuse => 1) or die "could not set up socket $!\n";

$select->add($socket);

my %inbuffer = ();
my %outbuffer = ();
my %ready = ();

sub setnonblock {
	my $socket = shift;
	my $flags;

	$flags = fcntl($socket, F_GETFL, 0)
		or die "Can't get flags for socket: $!\n";
	fcntl($socket, F_SETFL, $flags | O_NONBLOCK)
		or die "Can't make socket nonblocking: $!\n";
}

while(1) {
	foreach my $client ($select->can_read(1)) {
		if($client == $socket) {
			$client = $socket->accept();
			$select->add($client);
			setnonblock $client;
		} else {
			my $count = $client->recv(my $data, POSIX::BUFSIZ, 0);
			unless (defined($count) && length $data) {
				delete $inbuffer{$client};
				delete $outbuffer{$client};
				delete $ready{$client};

				$select->remove($client);
				close $client;
				next;
			}
			$inbuffer{$client} .= $data;
			if ($inbuffer{$client} =~ s/(.*\n)//) {
				$outbuffer{$client} = "I got $1"; #handle stuff here as you like
			}
		}
	}

	foreach my $client ($select->can_write(1)) {
		next unless exists $outbuffer{$client};
		my $count = $client->send($outbuffer{$client}, 0);
		if ($count == length $outbuffer{$client} ||
			$! == POSIX::EWOULDBLOCK) {
			substr($outbuffer{$client}, 0, $count) = '';
			delete $outbuffer{$client} unless length $outbuffer{$client};
		}
		next unless (defined $count);
	}
}