polling TCP server on Win32 (with Tk)

[JohnD]

I posted this in comp.lang.perl.tk but would like to give it a try over
here.

The problem is Win32 (Unix works). I do not understand the very
details of the differences between sockets on Unix and Windows. I just
want working code, the socket part (server).
If this socket part works I can get my real program working.

Who can help me producing a working program on Windows?

One server, one client. The client connects, sends strings (1-30 bytes)
once every few seconds, the server processes these strings within 0.1
seconds, and the connection remains open for an hour or so. If a fixed
string-length would be better: fine. If UDP is much easier: please show me.

My code so far (runs on Linux, freezes on Windows while processing the
first message)

#!/usr/bin/perl
use strict;
use warnings;
use IO::Socket;
use Tk;

$| = 1;
$SIG{PIPE} = 'IGNORE';

my $listen = IO::Socket::INET->new(
Proto => 'tcp',
LocalPort => 7777,
Listen => 1,
Reuse => 1,
) or die "Can't create listen socket : $!\n";

my $mw = MainWindow->new();

my $text = $mw->Scrolled( 'Text', )->pack();

my ($sel);
if ( $^O eq 'MSWin32' ) {
$mw->repeat( 50, [ \&new_connection, $listen ] );
}
else {
$mw->fileevent( $listen, 'readable' => [ \&new_connection, $listen ]
);
}

Tk::MainLoop;

sub new_connection {
my ($listen) = shift;
my ($sel);
my $client = $listen->accept() or warn "Can't accept connection";
$client->autoflush(1);
if ( $^O eq 'MSWin32' ) {
use IO::Select;
$sel = IO::Select->new;
$sel->add($listen);
$mw->repeat( 50, [ \&handle_connection, $client, $sel ] );
}
else {
$mw->fileevent( $client,
'readable' => [ \&handle_connection, $client, $sel ] );
}

$text->insert( 'end', "Connected\t" );
$text->see('end');
}

sub handle_connection {
my ( $client, $sel ) = shift;
if ( $^O eq 'MSWin32' ) {
my (@ready) = $sel->can_read(0);
return if $#ready == -1;
$client = $ready[0];
}
my $message = <$client>;
if ( defined $message and $message !~ /^quit/ ) {
$message =~ s/[\r\n]+$//;
$text->insert( 'end', "Got message [$message]\t" );
$text->see('end');
}
else {
$text->insert( 'end', "Connection Closed\n" );
$text->see('end');
$client->close();
}
}


A client (as simple as I could maker it)
#!/usr/bin/perl
use IO::Socket;

my $machine_addr = 'localhost';
$sock = new IO::Socket::INET(PeerAddr=>$machine_addr,
PeerPort=>7777,
Proto=>'tcp',
);

die "Could not connect: $!" unless $sock;

foreach my $count(1..100){
print $sock "$count\n";
print "$count\n";
#select(undef,undef,undef,.1) ;
}

close ($sock);

 

[QoS]

I posted this in comp.lang.perl.tk but would like to give it a try over
here.

The problem is Win32 (Unix works). I do not understand the very
details of the differences between sockets on Unix and Windows. I just
want working code, the socket part (server).
If this socket part works I can get my real program working.

Who can help me producing a working program on Windows?

One server, one client. The client connects, sends strings (1-30 bytes)
once every few seconds, the server processes these strings within 0.1
seconds, and the connection remains open for an hour or so. If a fixed
string-length would be better: fine. If UDP is much easier: please show me.

My code so far (runs on Linux, freezes on Windows while processing the
first message)

#!/usr/bin/perl
use strict;
use warnings;
use IO::Socket;
use Tk;

$| = 1;
$SIG{PIPE} = 'IGNORE';

my $listen = IO::Socket::INET->new(
Proto => 'tcp',
LocalPort => 7777,
Listen => 1,
Reuse => 1,
) or die "Can't create listen socket : $!\n";

my $mw = MainWindow->new();

my $text = $mw->Scrolled( 'Text', )->pack();

my ($sel);
if ( $^O eq 'MSWin32' ) {
$mw->repeat( 50, [ \&new_connection, $listen ] );
}
else {
$mw->fileevent( $listen, 'readable' => [ \&new_connection, $listen ]
);
}

Tk::MainLoop;

sub new_connection {
my ($listen) = shift;
my ($sel);
my $client = $listen->accept() or warn "Can't accept connection";
$client->autoflush(1);
if ( $^O eq 'MSWin32' ) {
use IO::Select;
$sel = IO::Select->new;
$sel->add($listen);
$mw->repeat( 50, [ \&handle_connection, $client, $sel ] );
}
else {
$mw->fileevent( $client,
'readable' => [ \&handle_connection, $client, $sel ] );
}

$text->insert( 'end', "Connected\t" );
$text->see('end');
}

sub handle_connection {
my ( $client, $sel ) = shift;
if ( $^O eq 'MSWin32' ) {
my (@ready) = $sel->can_read(0);
return if $#ready == -1;
$client = $ready[0];
}
my $message = <$client>;
if ( defined $message and $message !~ /^quit/ ) {
$message =~ s/[\r\n]+$//;
$text->insert( 'end', "Got message [$message]\t" );
$text->see('end');
}
else {
$text->insert( 'end', "Connection Closed\n" );
$text->see('end');
$client->close();
}
}


A client (as simple as I could maker it)
#!/usr/bin/perl
use IO::Socket;

my $machine_addr = 'localhost';
$sock = new IO::Socket::INET(PeerAddr=>$machine_addr,
PeerPort=>7777,
Proto=>'tcp',
);

die "Could not connect: $!" unless $sock;

foreach my $count(1..100){
print $sock "$count\n";
print "$count\n";
#select(undef,undef,undef,.1) ;
}

close ($sock);

Ok, this is an example of a threaded tk gui. Here we only print to
the console but you should be able to adapt this to suit your needs.

#!/usr/bin/perl
use strict;
use warnings;
use threads;
use threads::shared;
use Tk;

my (%shash, %threads, $mw,);

#initialize thread shared memory and gui
init();
#start gui
gui();
Tk::MainLoop();
#exit
foreach my $tId (keys %threads) {
$shash{$tId}{'die'} = 1;
sleep (1);
}
exit;
########################################################################
sub init #--------------------------------------------------------------
{
$mw = MainWindow->new();
#Example - one worker subroutine for one worker thread
foreach my $tId (1..1) {
foreach my $i qw(go1 progress die) {
share ($shash{$tId}{$i});
$shash{$tId}{$i} = 0;
}
$threads{$tId} = threads->new(\&worker1, $tId);
$threads{$tId}->detach();
warn "launched thread ($tId)\n";
}
return (1);
}
sub gui #---------------------------------------------------------------
{
my $c = 1;
foreach my $csv ('on,1', 'off,0') {
my ($label,$state) = split(/,/, $csv);
$mw->Button(
-text => $label,
-command => sub {$shash{1}{go1} = $state;}
)->pack();
}
return (1);
}
sub worker1 #-----------------------------------------------------------
{
my $tId = $_[0] || return (0);
local $| = 1;

warn "welcome to worker1 ($tId)\n";

workerLoop:
while (1) {
if ( $shash{$tId}{'die'} == 1) {
last;
};
if ( $shash{$tId}{'go1'} == 1 ) {
foreach my $num (1..10){
$shash{$tId}{'progress'} = $num;
warn "\tThread (".$tId.") says: ($tId->$num)\n";
if($shash{$tId}{'go1'} == 0) { last; }
if($shash{$tId}{'die'} == 1) { last workerLoop; };
sleep(1);
}
$shash{$tId}{'go01'} = 0;
}
else {
sleep(1);
}
}
warn "thread ($tId) is exiting worker1\n";
return (1);
}
########################################################################

hTh,
J