Velocity Reviews - Computer Hardware Reviews

Velocity Reviews > Newsgroups > Programming > Perl > Perl Misc > polling TCP server on Win32 (with Tk)

Reply
Thread Tools

polling TCP server on Win32 (with Tk)

 
 
JohnD
Guest
Posts: n/a
 
      03-22-2011
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);


 
Reply With Quote
 
 
 
 
QoS
Guest
Posts: n/a
 
      03-23-2011

JohnD <(E-Mail Removed)> wrote in message-id: <4d887b62$0$9483$(E-Mail Removed)4all.nl >

>
> 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

 
Reply With Quote
 
 
 
Reply

Thread Tools

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are Off


Similar Threads
Thread Thread Starter Forum Replies Last Post
AJAX/stale browser data/polling vs. server push/drag and drop petermichaux@gmail.com Javascript 3 05-07-2006 05:40 PM
About Polling Chat Server (Personal Chatting) Sameer Java 0 02-13-2005 05:27 PM
NAT two outside TCP ports to one inside TCP port Kevin Cisco 1 11-10-2004 08:15 AM
LPR/Standard, TCP/IP, HP TCP/IP Ports DJ Chiro MCSE 1 11-07-2003 08:06 PM
Help With a Polling Server Chuck Java 1 08-22-2003 02:31 PM



Advertisments