#!/usr/bin/env perl
use strict;
use warnings;
use Tk;
use IO::Socket;
my $status = '';
my $mw = MainWindow->new;
my $control_F = $mw->Frame()->pack(-side => 'bottom');
$control_F->Button(-text => 'Listen',
-command => sub { start_server(\$mw, \$status) }
)->pack(-side => 'left');
$control_F->Button(-text => 'Quit', -command => sub { exit }
)->pack(-side => 'left');
my $status_F = $mw->Frame()->pack(-side => 'top');
$status_F->Label(-text => 'Status:')->pack(-side => 'left');
$status_F->Label(-textvariable => \$status)->pack(-side => 'left');
MainLoop;
sub start_server {
my ($mw_ref, $status_ref) = @_;
my $server = IO::Socket::INET::->new(
Proto => 'tcp',
LocalPort => 55555,
Listen => SOMAXCONN,
Reuse => 1
) or die "Server can't start: $!";
my $client = $server->accept();
$client->autoflush;
$$mw_ref->fileevent($client, 'readable', sub {
if (defined(my $read = <$client>)) {
chomp $read;
$$status_ref = $read;
}
});
}
####
#!/usr/bin/env perl
use strict;
use warnings;
use IO::Socket;
my $client = IO::Socket::INET::->new(
Proto => 'tcp',
PeerAddr => 'localhost',
PeerPort => 55555
) or die "Client can't connect: $!";
my @msgs = 'A' .. 'Z';
for (@msgs) {
print $client "$_\n";
sleep 1;
}
##
##
$ pm_asynch_sock_server_tk.pl &
##
##
$ pm_asynch_sock_client.pl &