#!/usr/bin/env perl
use strict;
use warnings;
use Tk;
use IO::Socket;
my $mw = MainWindow->new;
my $control_F = $mw->Frame()->pack(-side => 'bottom');
my $out_F = $mw->Frame()->pack(-side => 'top', -fill => 'both', -expan
+d => 1);
my $out_T = $out_F->Scrolled('Text', -scrollbars => 'osoe', -wrap => '
+none');
$out_T->pack(-fill => 'both', -expand => 1);
my $out_win = $out_T;
my $delay = 100;
my ($client, $tid);
my @button_pack_opts = (-side => 'left', -padx => 10);
$control_F->Button(-text => 'Start Server',
-command => [\&start_server, \$client]
)->pack(@button_pack_opts);
$control_F->Button(-text => 'Start Listening',
-command => [\&start_listen, \$mw, \$client, \$tid, \$delay, \$out
+_win]
)->pack(@button_pack_opts);
$control_F->Button(-text => 'Stop Listening',
-command => [\&stop_listen, \$out_win, \$tid]
)->pack(@button_pack_opts);
$control_F->Button(-text => 'Quit',
-command => sub { exit }
)->pack(@button_pack_opts);
MainLoop;
sub start_server {
my ($client_ref) = @_;
my $server = IO::Socket::INET::->new(
Proto => 'tcp',
LocalPort => 55555,
Listen => SOMAXCONN,
Reuse => 1
) or die "Server can't start: $!";
$$client_ref = $server->accept();
$$client_ref->autoflush;
return;
}
sub start_listen {
my ($mw_ref, $client_ref, $tid_ref, $delay_ref, $out_ref) = @_;
$$tid_ref = $$mw_ref->repeat(
$$delay_ref => [\&read_client, $mw_ref, $client_ref, $out_ref]
+
);
return;
}
sub stop_listen {
my ($out_ref, $tid_ref) = @_;
my $times_format = "(Usr: %d, Sys: %d, ChUsr: %d, ChSys: %d)\n";
$$out_ref->insert(end => sprintf $times_format => times);
$$out_ref->yview('end');
$$tid_ref->cancel;
return;
}
sub read_client {
my ($mw_ref, $client_ref, $out_ref) = @_;
$$mw_ref->fileevent($$client_ref, 'readable', sub {
if (defined(my $read = readline *$$client_ref)) {
$$out_ref->insert(end => $read);
$$out_ref->yview('end');
}
else {
$$mw_ref->fileevent($$client_ref, 'readable', '');
}
});
return;
}
Dummy Client (pm_tk_repeat_client.pl):
#!/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 $max_iterations = 3;
my $sleep_time = 10;
for (1 .. $max_iterations) {
print $client qx{ls -al 2>&1};
sleep $sleep_time;
}
Notes:
-
Run the GUI Server code and click the Start Server button.
-
Run the Dummy Client code.
-
Go back to the GUI Server and click the Start Listening button: output should appear in the Tk::Text window.
-
You can stop the output with the Stop Listening button.
(You can Start/Stop Listening as often as you want.)
The repeat() and cancel() methods are in the callbacks for these two buttons.
-
The callback for the repeat event is read_client().
The file event handler is both created and deleted within this subroutine.
-
See perlipc if you have any questions about the Client/Server IO::Socket code: it mostly came from there pretty much unchanged.
|