#! perl -slw use strict; use threads ( stack_size => 4096 ); use IO::Socket; use constant { SERVERIP => '127.0.0.1', SERVERPORT => 3000, MAXBUF => 4096, }; sub s2S{ my( $p, $h ) = sockaddr_in( $_[0] ); $h = inet_ntoa( $h ); "$h:$p"; } my %DB :shared; chomp, $DB{ $_ } = $. while <>; close *ARGV; my $lsn = IO::Socket::INET->new( LocalHost => SERVERIP, LocalPort => SERVERPORT, Reuse => 1, Listen => SOMAXCONN ) or die $!; print "Listening..."; while( my $client = $lsn->accept ) { async { while( 1 ) { $client->recv( my $in, MAXBUF ); unless( length $in ) { print "Disconnected from ", s2S $client->peername; shutdown $client, 2; close $client; 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' ); } } }->detach; } sleep 1e9;