Book HomeMastering Perl/TkSearch this book

19.6. Polling Win32 Sockets

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.



Library Navigation Links

Copyright © 2002 O'Reilly & Associates. All rights reserved.