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.