#! perl -slw use strict; use threads; use Thread::Queue; use IO::Socket; use constant { SERVERIP => '127.0.0.1', SERVERPORT => 3000, MAXBUF => 4096, }; our $R //= 8; sub s2S{ my( $p, $h ) = sockaddr_in( $_[0] ); $h = inet_ntoa( $h ); "$h:$p"; } my %DB :shared; chomp, $DB{ $_ } = $. while <>; close *ARGV; my $Q = new Thread::Queue; my $Qcleanup = new Thread::Queue; sub responder { my $tid = threads->tid; while( my $fileno = $Q->dequeue() ) { print "[$tid] Servicing fileno: $fileno"; open my $client, '+<&=', $fileno or die $!; bless $client, 'IO::Socket::INET'; while( 1 ) { $client->recv( my $in, MAXBUF ); unless( length $in ) { print "Disconnected from ", s2S $client->peername; shutdown $client, 2; close $client; $Qcleanup->enqueue( $fileno ); last; }; print "Received $in from ", s2S $client->peername; my( $cmd, @args ) = split ' ', $in; if( $cmd eq 'FETCH' ) { $client->send( $DB{ $args[ 0 ] } ); } else { $client->send( 'Bad command' ); } } } } threads->create( \&responder )->detach for 1 .. $R; my $lsn = IO::Socket::INET->new( LocalHost => SERVERIP, LocalPort => SERVERPORT, Reuse => 1, Listen => SOMAXCONN ) or die $!; my @clients; print "Listening..."; while( my $client = $lsn->accept ) { my $fileno = fileno( $client ); $clients[ $fileno ] = $client; print "[0] queing ", $fileno; $Q->enqueue( $fileno ); close $clients[ $Qcleanup->dequeue ] while $Qcleanup->pending; }