#!/usr/bin/perl -w

use strict;

use Tk;
use Symbol qw(gensym);
use IO::Socket;

$ENV{HOME} = "/" unless $ENV{HOME};

print( "Listening on localhost port 31415.  Telnet to it and try\n",
       "entering something.  In an ideal world, it should echo back.\n
+"
     );

my $acceptor = IO::Socket::INET->new
  ( LocalAddr => '127.0.0.1',
    LocalPort => 31415,
    Listen    => 5,
    Reuse     => 'yes',
  );

my $client = $acceptor->accept();
die "Could not accept a client: $!" unless defined $client;

print "Client connection accepted.\n";

# Turn off buffering.
select((select($client), $| = 1)[0]);

# Send a welcome message.

print $client "Hello!\x0d\x0a";

print "Setting callback for $client.\n";
my $main_window = Tk::MainWindow->new();
$main_window->fileevent( $client, 'readable', [ \&read_client ] );
print "Callback set.\n";

Tk::MainLoop();
exit 0;

sub read_client {
  print "Client callback has been invoked.\n";
  my $line = <$client>;
  exit unless defined $line;
  print $client $line;
}
[download]