$data = '';
$data .= $buffer while sysread( $fh, $buffer, 1 ) and $buffer ne "\n";
####
die "Can't write to server!\n" unless $server->can_write
syswrite($sock, "$data\n" );
####
if ( $client->can_write ) {
syswrite( $fh, "$data\n" );
}
####
#! /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();