#! /usr/bin/perl -w
use strict;
use IO::Socket::INET;
use POE qw(Wheel::ListenAccept Wheel::ReadWrite);

my $listening_port=8019;
my $rtk_port = 4004;
# my $rtk_port = "echo";
my $rtk_ip   = "localhost";

my $listener = IO::Socket::INET->new(LocalPort  => $listening_port,
                                     Reuse      => 1,
                                     Listen     =>512) ||
    die "Could create to listening socket on port $listening_port: $!\n";
# I don't bother with a POE::Wheel::SocketFactory here since
# I want to know immediately if the server can't be reached.
my $server = IO::Socket::INET->new(PeerAddr     => $rtk_ip,
                                   PeerPort     => $rtk_port) ||
    die "Could create rtk socket on IP $rtk_ip and port $rtk_port: $!\n";

POE::Session->create(inline_states => {
    _start              => \&start,
    "accept"            => \&do_accept,
    "accept_error"      => sub { warn "$_[ARG0] error: $_[ARG2]\n" },
    "client_input"      => \&client_input,
    "client_end"        => \&client_end,
    "client_flushed"    => sub { delete $_[HEAP]->{clients}{$_[ARG0]} },
    "server_input"      => \&server_input,
    "server_end"        => \&server_end,
    _default            => sub {
        die("calling non existant event ", $_[ARG0]) unless
            substr($_[ARG0], 0, 1) eq "_";
        return;
    }
});

sub start {
    my $heap = $_[HEAP];
    $heap->{listener} = POE::Wheel::ListenAccept->new
        (Handle      => $listener,
         AcceptEvent => "accept",
         ErrorEvent  => "accept_error");
    $heap->{server} = POE::Wheel::ReadWrite->new
        (Handle => $server,
         InputEvent => "server_input",
         ErrorEvent => "server_end");
    $heap->{id_queue} = [];
    $heap->{clients} = {};
}

sub do_accept {
    my ($heap, $new_sock) = @_[HEAP, ARG0];
    my $client = POE::Wheel::ReadWrite->new
        (Handle => $new_sock,
         InputEvent => "client_input",
         ErrorEvent => "client_end");
    $heap->{clients}{$client->ID} = $client;
}

sub client_input {
    my ($heap, $line, $client_id) = @_[HEAP, ARG0, ARG1];
    if ($heap->{server}) {
        if ($line =~ /exit/) {
            close_on_empty($heap, $client_id);
        } else {
            # Remember for which client id we queue this line
            push @{$heap->{id_queue}}, $client_id;
            $heap->{server}->put($line);
        }
    }
}

sub client_end {
    my ($heap, $operation, $errnum, $errstr, $client_id) = @_[HEAP,ARG0..ARG3];
    warn "$operation: $errstr\n" if $errnum;
    delete $heap->{clients}->{$client_id};
}

sub server_input {
    my $heap = $_[HEAP];
    my $id = shift @{$heap->{id_queue}} || 
        die "multiline echos from server ?";
    $heap->{clients}{$id}->put($_[ARG0]) if $heap->{clients}{$id};
}

sub server_end {
    my ($heap, $operation, $errnum, $errstr) = @_[HEAP,ARG0..ARG2];
    warn "$operation: $errstr\n" if $errnum;
    warn "Server shutdown\n";
    delete $heap->{server};
    delete $heap->{listener};
    close $listener;
    close_on_empty($heap, $_) for keys %{$heap->{clients}};
}

sub close_on_empty {
    my ($heap, $client_id) = @_;
    my $client = $heap->{clients}{$client_id};
    if ($client->get_driver_out_octets) {
        $client->event("FlushedEvent", "client_flushed");
    } else {
        delete $heap->{clients}{$client_id};
    }
}

$poe_kernel->run();