Perl: Bidirektionale Kommunikation über Sockets

[Molaf]

Hallo allerseits,

ich habe hier (schon wieder) ein Problem mit der Datenübertragung über Sockets. Wieder, weil das bei mir glaubich noch nie richtig geklappt hat. Üblicherweise tippe ich dann ein Beispiel aus dem Perl-Kochbuch ab, aber auch das klapt spätestens dann nicht mehr, wenn ich es auf Senden UND Empfangen umgestellt habe.

Ich habe zwei Skripte, eines ein Server, der immer wieder kurze Datenpakete von einem anderen Socket erhält, und dieses an mein zweites Skript weitergibt, wenn es ab und an mal eine Anfrage stellt (für mich egal welche Anfrage, also 'hallo' würde reichen, nur das Event an sich zählt).

Erstmal die Skripte:

#!/usr/bin/perl
use strict;
use Net::Server::NonBlocking;
$|=1;

my $stand=":startwert:\n";

my $obj=Net::Server::NonBlocking->new();
$obj->add({
server_name => 'Anzeige',
local_port => 10001,
timeout => 120,
delimiter => "\r\n",
on_connected => \&anzeige_connected,
on_disconnected => \&anzeige_disconnected,
on_recv_msg => \&anzeige_message
});
#
$obj->start;

sub anzeige_connected
{
my $self=shift;
my $client=shift;
print $client $stand,"\n";
print "Anzeige-Programm hat sich verbunden.\n";
}

sub anzeige_disconnected
{
print "Anzeige-Programm hat sich wieder getrennt.\n";
}

sub anzeige_message
{
my $self=shift;
my $client=shift;
my $message=shift;

print 'Message(Anzeige):'.$message; # \n müßte ja in $message enthalten sein
print $client $stand;
}

Das entspricht bis auf ein nachträgliches use strict; und angepaßte Prozedurnamen dem Beispielcode der Dokumentation von Net::Server:Nonblocking.
Noch der Client:

#!/usr/bin/perl
use strict;
use Tk;

### tcp-client registrieren ###
use IO::Socket;
my $socket = IO::Socket::INET->new(
PeerAddr => 'localhost',
PeerPort => 10001,
Proto => "tcp",
Type => SOCK_STREAM)
or die "\nKonnte keine Verbindung zum Server herstellen\n\n";

$|=1;

### tk-oberfläche ###
my $mw = MainWindow->new();
my $cv = $mw->Label(-text=>'test')->pack();

$mw->repeat(1000,sub{checkup();});

MainLoop;


sub checkup
{
# server kontaktieren
print "sende an socket\n";
print $socket "tach\n\n" or die;

# antwort vom server abholen
print "warte auf socket\n";
my $input = join '', <$socket>;
print "antwort von socket:'$input'\n";

# antwort verarbeiten
# ...
}

Hierbei das Problem: Es handelt sich um ein Programm mit Tk, also die Datenübertragung sollte nicht so lange dauern, damit das Programm während des repeat-Callbacks nicht einfriert.

Aus beiden Skripten habe ich den Ballast mal rausgeschnitten, dies sind nur die Minimalkörper.

'sende an socket' erscheint als Kontrollausgabe des Clients sofort, dann hängt es aber sofort nach 'warte auf socket' für einige Minuten, dann kommt 'antwort von socket:'' ' offenbar nach dem timeout, dann beendet sich der Client selbst ('sende an socket' kommt noch einmal).

Der Server meldet keine empfangene message, lediglich das Verbinden und dann das Trennen des Clients, wenn er abschmiert.

Offenbar liegt das Problem ja vor dem Bildschirm, ich weiß aber echt nicht was ich noch tun kann. print $socket $daten; und $daten=<$socket>; stehen auch so im Perl-Buch und werden auch als Beispiel von IO::Socket genannt.

Was kann es nur sein?