#!perl -slw
use strict;
use threads;
use Thread::Queue;
use Smart::Comments::Lite '0';

sub worker {
    require IO::Socket::INET;
    my $tid = threads->tid;
    our $running:shared;
    our $busy:shared;
    our $die:shared;
    my( $Qwork, $Qtrace ) = @_;

    ++$running;
    while( my $fno = $Qwork->dequeue() ) {
        ##1 warn "$tid($fno): Client waiting on $fno\n";
        my $client = IO::Socket::INET->new;
        $client->fdopen( $fno, '+>' )
            or die "$tid: Failed to reopen fileno: $fno";
        ##2 warn "$tid($fno): reopened $client\n";
        ++$busy;

        ##2 warn "$tid($fno): Reading from client\n";
        while( my $data = <$client> ) {
            chomp $data;
            ##2 warn "$tid($fno): Got '$data'\n";
            $Qtrace->enqueue( $data );
        }
        ##2 warn  "$tid($fno): Client disconnected\n";
        close $client;
        shutdown( $client, 2 );
        --$busy;
    }
    --$running;
}

our $START ||= 2;
our $MAX   ||= 2000;
our $running:shared = 0;
our $busy:shared    = 0;
our $die:shared     = 0;
our $connects:shared=0;

## Use ctrl-break to terminate the server.
local $SIG{INT} = sub{
    warn "SIGINT(2) terminating";
    $die = 1;
};

my $Qwork  = new Thread::Queue;
my $Qtrace = new Thread::Queue;
our %clients;

my @threads = map{
    threads->create( \&worker, $Qwork, $Qtrace )
        or warn( "Create thread $_ failed with $^E\n" ), ();
} 1 .. $START;
## This creates new threads if the current pool is running low
async{
    until( $die ) {
        if( ( $busy + 2 ) == $running and $running < $MAX ) {
            push @threads, threads->create( \&worker, $Qwork, $Qtrace )
                or warn( "Create thread $_ failed with $^E\n" ), ();
        }
        sleep 1;
    }
};

## This reads and dumps the trace information to the screen.
async{
    until( $die ) {
        print $Qtrace->dequeue();
    }
}

require IO::Socket::INET;
my $server = IO::Socket::INET->new(
    LocalPort => 54321,
    Listen   => 1000,
    Reuse    => 1.
) or die $!, $^E;

## Currently, the client sockets are not cleaned up and will eventually run out of resource.
## Fixes welcome :)
my $fno;
while( not $die and ( my $client = $server->accept ) > 0 ) {
    ++$connects;
    $clients{ $client->fileno } = $client;
    $Qwork->enqueue( $client->fileno );
}
warn "\a*** Accept failed ***\a\n" and $die = 1;
close $server;

$Qwork->enqueue( undef ) for 1 .. $running;
sleep 1 while $running;
$_->join for @threads;