If fileevent fails us in a Win32 environment, a simple and effective remedy, suggested by Brand Hilton, is to poll the socket ourselves. Here we have a simple poll daemon that works on Unix and Win32. It waits for a connect on port 10254 and outputs 5 bytes on the socket every five seconds. (Please excuse the lack of error processing.)
use IO::Socket;
use Tk;
use strict;
my $socket = IO::Socket::INET->new(
Listen => 5,
Reuse => 1,
LocalPort => 10254,
Proto => 'tcp',
) or die "Couldn't open socket: $!";
my $new_sock = $socket->accept( );
while (1) {
syswrite $new_sock, "polld";
sleep 5;
}
Given that, we'd expect the following Tk poll client to work in both operating environments. The client packs a Text widget, connects to the poll daemon, and creates a fileevent handler to read the incoming socket data and append it to the Text widget. It works perfectly under Unix, but alas, on Win32, the I/O handler is never called.
use IO::Socket;
use Tk;
use strict;
my $mw = MainWindow->new;
my $text = $mw->Text->pack;
my $sock = IO::Socket::INET->new(PeerAddr => 'localhost:10254');
die "Cannot connect" unless defined $sock;
$mw->fileevent($sock, 'readable' => \&read_sock);
MainLoop;
sub read_sock {
my $numbytes = 5;
my $line;
while ($numbytes) {
my $buf;
my $num = sysread $sock, $buf, $numbytes;
$numbytes -= $num;
$line .= $buf;
}
$text->insert('end',"$line\n");
}
Here's a revised poll client that still uses fileevent for Unix. But if it's running under Win32, it creates a timer event that uses select to poll the socket. You can use select directly, but the IO::Select OO interface is easier to use. So, $sel becomes our IO::Select object, to which we add one handle to monitor, the read socket. Subroutine read_sock uses the can_read method to determine if the socket has available data and, if so, sets $hand for sysread.
use IO::Socket;
use Tk;
use subs qw/read_sock/;
use vars qw/$mw $sel $sock $text/;
use strict;
$mw = MainWindow->new;
$text = $mw->Text->pack;
$sock = IO::Socket::INET->new(PeerAddr => 'localhost:10254');
die "Cannot connect" unless defined $sock;
if ($^O eq 'MSWin32') {
use IO::Select;
$sel = IO::Select->new;
$sel->add($sock);
$mw->repeat(50 => \&read_sock);
} else {
$mw->fileevent($sock, 'readable' => \&read_sock);
}
MainLoop;
sub read_sock {
my $hand = $sock;
if ($^O eq 'MSWin32') {
my(@ready) = $sel->can_read(0);
return if $#ready == -1;
$hand = $ready[0];
}
my $numbytes = length 'polld';
my $line;
while ($numbytes) {
my $buf;
my $num = sysread $hand, $buf, $numbytes;
$numbytes -= $num;
$line .= $buf;
}
$text->insert('end',"$line\n");
} # end read_sock
Be sure to check out Chapter 22, "Perl/Tk and the Web" and see how we can employ a shared memory segment to bypass fileevent on Win32.
Copyright © 2002 O'Reilly & Associates. All rights reserved.