PERLでTCPサーバ

#!/usr/bin/perl -w
# $Id: tcp-server-perl.html,v 1.1 2009/06/22 16:12:29 kishi Exp kishi $
# Note: This is thread safe. However thread number is not limited.

use strict;
use IO::Socket;
use Net::hostent;
use POSIX 'strftime';
use threads;

if( $#ARGV + 1 != 1 ){
        print STDERR "Usage: $0 [portNumber]" . "\n";
        exit -1;
}
my $PORT = $ARGV[0];

my $BUFFER_SIZE = 512;
my $response_data = "./response.txt";
my $resBuf;

$| = 1; # perform flush after each write to STDOUT

#-----------------------------------------
# open response data
#-----------------------------------------
open(RES, $response_data) || die "can't open $response_data";
while( <RES> ){
        $resBuf .= $_;
}
close(RES);

#-----------------------------------------
# Create server instance
#-----------------------------------------
my $server = IO::Socket::INET->new( Proto     => 'tcp',
                                  LocalPort => $PORT,
                                  Listen    => SOMAXCONN,
                                  Blocking    => 1);
die "can't setup server" unless $server;

print "[Server $0 accepting clients]\n";

#------------------------------------------------------
#  Obtain client socket and process via a new thread
#------------------------------------------------------
while (my $client = $server->accept()) {
    my $thread = threads->new( \&processClient, $client);
    $thread->detach();
}

sub processClient {
    #-----------------------------------------
    # Read the request from client
    #-----------------------------------------
    my ($clientSock) = @_;

    $clientSock->autoflush;
    my $hostinfo = gethostbyaddr($clientSock->peeraddr);
    my $now = strftime "%Y/%m/%d %H:%M:%S", localtime;
    printf("\n");
    printf ("[Connected from %s -- %s]\n", $hostinfo->name || $clientSock->peerhost, $now);

    print "------------------ receive() STARTED ------------------------\n";
    my $buffer = "";
    while( (my $n = sysread( $clientSock, $buffer, $BUFFER_SIZE ) ) > 0  ){
           print $buffer;
    }
    print "------------------ receive() COMPLETED ----------------------\n";

    #----------------------------------------
    # Reply message to client
    #----------------------------------------
    syswrite($clientSock, $resBuf, length($resBuf));

    close $clientSock;
}