#! perl -slw
use strict;

package Registry::Agent;

sub new {
    my( $class, %config ) = @_;
    return bless \%config, $class;
}
sub makeRequest{
    die "makeRequest for class ${ ref $_[0] } not reified";
}

package Registry::Agent::A;
use base 'Registry::Agent';
sub makeRequest{ sleep rand 30; return "The Answer from A"; }

package Registry::Agent::B;
use base 'Registry::Agent';
sub makeRequest{ sleep rand 30; return "The Answer from B"; }

package Registry::Agent::C;
use base 'Registry::Agent';
sub makeRequest{ sleep rand 30; return "The Answer from C"; }


package main;
use threads;
use Thread::Queue;

sub registryAgent {
    my( $class, $Qin, $Qout, %otherConfig ) = @_;

    #require $class; ## Disabled for mocked up agents.

    my $agent = $class->new( %otherConfig )
        or die "Couldn't create '$class' object\n";

    while( my $workItem = $Qin->dequeue ) {

        my( $tag, $request ) = unpack 'N/A* N/A*', $workItem;
        warn "$class: Got request for $tag:$request\n";

        my $result = $agent->makeRequest( $request );
        warn "$class: returning $result for $tag\n";

        $Qout->enqueue( pack 'N/A* N/A*', $tag, $result );
    }
}

my $Qresults = new Thread::Queue;

my %workQs;
my @agents = map{
    my $Qwork = new Thread::Queue;
    $workQs{ $_ } = $Qwork;
    threads->create( 
        \&registryAgent, $_, $Qwork, $Qresults, 
        configA => 1, configB => 2 
    );
} qw[ Registry::Agent::A Registry::Agent::B Registry::Agent::C ];

require IO::Socket::INET;

my $listener = IO::Socket::INET->new(
    LocalAddr => 'localhost:33333',
    Listen => 100,
    Blocking => 0,
) or die "Couldn't listen on localhost:33333; $!";

ioctl( $listener, 0x8004667e, \1 ); ## non-blocking on Win32

my $done = 0;
$SIG{ INT } = sub{
    shutdown( $listener, 0 );                   ## Stop listening
    $_->enqueue( undef ) for values %workQs;    ## Signal termination to threads
    $_->join for @agents;                       ## Perform last rites.
    $done = 1;                                  ## Tell main thread we're done.
};

my %clients;
while( !$done ) {
    if( my $client = $listener->accept ) {
        warn "main: Client:$client connected\n";

        my $fno = fileno $client;
        $clients{ $fno } = $client;

        defined( my $request = <$client> )
            or warn "Read failed: $!\n" and next;

        my( $agent, $rest ) = split ':', $request, 2;
        warn "main: Client: $client requests Agent:$agent Request:$rest\n";

        $workQs{ "Registry::Agent::$agent" }->enqueue(
            pack "N/A* N/A*", $fno, $rest
        );
    }
    elsif( my $result = $Qresults->dequeue_nb ) {

        my( $fno, $reply ) = unpack 'N/A* N/A*', $result;
        warn "Got reply for request tag:$fno; sending...\n";

        print { $clients{ $fno } } $reply;
        close delete $clients{ $fno };
    }
    else {
        sleep 1;
    }
}
close $listener;