#!/usr/bin/perl use strict; use warnings; use IO::Socket; use Tk; $|=1; $SIG{PIPE} = 'IGNORE'; my $listen = IO::Socket::INET->new( Proto => 'tcp', LocalPort => 7070, Listen => 1, Reuse => 1, ) or die "Can't create listen socket : $!\n"; my $mw = MainWindow->new(); my $text = $mw->Scrolled('Text', -background =>'black', -foreground => 'yellow', )->pack(); my $subframe = $mw->Frame()->pack(); $subframe->Button(-text => 'Clear', -command => sub { $text->delete('1.0','end'); })->pack(-side=>'left'); $subframe->Button(-text => 'Save Log', -command => sub { })->pack(-side=>'left'); $subframe->Button(-text => 'Exit', -command => sub { exit })->pack(-side=>'right'); $mw->fileevent($listen, 'readable', sub { new_connection($listen) }); Tk::MainLoop; sub new_connection { my ($listen) = @_; my $client = $listen->accept() or warn "Can't accept connection"; $client->autoflush(1); $mw->fileevent($client, 'readable', sub { handle_connection($client) }); #$client->print("Connected\n"); $text->insert('end', "Connected\t"); $text->see('end'); } sub handle_connection { my ($client) = @_; my $message = <$client>; if (defined $message and $message !~ /^quit/) { $message =~ s/[\r\n]+$//; #$client->print("Got message [$message]\n"); #echo back if wanted $text->insert('end', "Got message [$message]\t"); $text->see('end'); } else { $text->insert('end', "Connection Closed\n"); $text->see('end'); $client->close(); } }