if you
- just send 1 statement at a time and
- then disconnect and reconnect for the next one,
- each transmission terminate by $EOL
you could try this deamon, which seems to work for several hundred parallel client attempts. (i brute forced it up to 700..800x8kB - took 1.5 min, but the first 500 went through within 20..30sec or so - but with just 100 at a time youre done in about 10 sec. so depending on your average and peek load you have to monitor the runtime of the clients. just do several scenarios for your use and see if there is still a bottleneck...) :


#!/usr/bin/perl -Tw

use strict;
use warnings;
use IO::Socket;
use Net::hostent;
use ResourcePool;
use ResourcePool::Factory::DBI;
use ResourcePool::Command::DBI::Execute;

my $EOL = "\015\012";
sub spawn;
my $port = 6000;
my $proto = getprotobyname('tcp');
my $dsn = "DBI:mysql:DB;HOST;3306";
my $username = "xxx";
my $passwd = "yyy";

my $factory = ResourcePool::Factory::DBI->new($dsn,$username,$passwd);
my $pool = ResourcePool->new($factory, MaxTry => 3);

socket(Server, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
setsockopt(Server, SOL_SOCKET, SO_REUSEADDR, pack("l", 1)) || die "setsockopt: $!";
bind(Server, sockaddr_in($port, INADDR_ANY)) || die "bind: $!";
listen(Server,SOMAXCONN) || die "listen: $!";

my $waitedpid = 0;
my $paddr;
$SIG{CHLD} = 'IGNORE';

for ($waitedpid = 0; ($paddr = accept(CLIENT,Server)) || $waitedpid; $waitedpid = 0, close CLIENT)
{
   next if $waitedpid and not $paddr;
   my($port,$iaddr) = sockaddr_in($paddr);
   my $name = gethostbyaddr($iaddr,AF_INET);

   spawn sub {
      $|=1;
      my $line; my $clientdata = '';
      for (;;)
      {
         undef $!;
         unless (defined($line= <> ))
         {
            die $! if $!;
            last; # reached EOF
         }
         $clientdata .= $line;
         last if eof;
      }
      my $cmd = ResourcePool::Command::DBI::Execute->new();
   $pool->execute($cmd, $clientdata);
   # and here may be a possibility to send data back to the client (f.i. lastinsertid)
   # <> = "place return data here $EOL";
   };
}

sub spawn
{
   my $coderef = shift;
   unless (@_ == 0 && $coderef && ref($coderef) eq 'CODE')
   {confess "usage: spawn CODEREF";}
   my $pid;
   if (!defined($pid = fork))
   {return;} elsif ($pid) {return; # I'm the parent}
   # else I'm the child -- go spawn
   open(STDIN, "<&CLIENT") || die "can't dup client to stdin";
   open(STDOUT, ">&CLIENT") || die "can't dup client to stdout";
   exit &$coderef();
}