Beefy Boxes and Bandwidth Generously Provided by pair Networks
Problems? Is your data what you think it is?
 
PerlMonks  

asynchronous socket communication with perl tk

by simonz (Acolyte)
on Sep 25, 2013 at 12:35 UTC ( #1055676=perlquestion: print w/ replies, xml ) Need Help??
simonz has asked for the wisdom of the Perl Monks concerning the following question:

Hi
I am including a code below which demonstrates a simple client-server communication in a perl tk window. How can I achieve this communication when multiple clients are trying to interact at a time.

server code
use Tk; use IO::Socket; my $status = ''; my $mw = MainWindow->new; $mw->geometry("200x200"); my $buttonFrame = $mw->Frame()->pack(-side => 'bottom'); $buttonFrame->Button(-text => 'Start', -command => sub { init_server(\$mw, \$status) } )->pack(-side => 'left'); my $displayFrame = $mw->Frame()->pack(-side => 'top'); $displayFrame->Label(-text => 'Status:')->pack(-side => 'left'); $displayFrame->Label(-textvariable => \$status)->pack(-side => 'left') +; MainLoop; sub init_server { my ($mw_ref, $status_ref) = @_; my $server = IO::Socket::INET::->new( Proto => 'tcp', LocalPort => 55555, Listen => 1, Reuse => 1 ) or die "Server can't start: $!"; my $client = $server->accept(); $client->autoflush; $$mw_ref->fileevent($client, 'readable', sub { if (defined(my $read = <$client>)) { chomp $read; $$status_ref = $read; } }); }
client code
use IO::Socket; my $client = IO::Socket::INET::->new( Proto => 'tcp', PeerAddr => 'localhost', PeerPort => 55555 ) or die "Client can't connect: $!"; my @msgs = qw(msg1 msg2 msg3 msg4 msg5); for (@msgs) { print $client "$_\n"; sleep 1; }

Comment on asynchronous socket communication with perl tk
Select or Download Code
Re: asynchronous socket communication with perl tk
by kcott (Abbot) on Sep 25, 2013 at 13:18 UTC

    G'day simonz,

    You took that code from this thread (which has exactly the same name): asynchronous socket comunication with perl tk

    In that thread, the request was for: "... an example of asynchronous socket communication happening through a perl tk application. A very simple and primitive one."

    When I wrote that code last month, I included links to related documentation. If you follow those links, particularly the ones to sections of perlipc, you'll find examples of more complex socket I/O (including multiple clients).

    -- Ken

      Hi, I have made the following modifications in the server code for asynchronous communication, but the server gui hangs as I start the client.

      use strict; use warnings; use Tk; use IO::Socket; use IO::Select; my $status = ''; my $mw = MainWindow->new; $mw->geometry("200x200"); my $buttonFrame = $mw->Frame()->pack(-side => 'bottom'); $buttonFrame->Button(-text => 'Start', -command => sub { init_server(\$mw, \$status) } )->pack(-side => 'left'); my $displayFrame = $mw->Frame()->pack(-side => 'top'); $displayFrame->Label(-text => 'Status:')->pack(-side => 'left'); $displayFrame->Label(-textvariable => \$status)->pack(-side => 'left') +; my $server; MainLoop; sub init_server { my ($mw_ref, $status_ref) = @_; $server = IO::Socket::INET::->new( Proto => 'tcp', LocalPort => 55555, Listen => 1, Reuse => 1 ) or die "Server can't start: $!"; =cut my $client = $server->accept(); $client->autoflush; $$mw_ref->fileevent($client, 'readable', sub { if (defined(my $read = <$client>)) { chomp $read; $$status_ref = $read; } }); =cut #my $client = $server->accept(); $$mw_ref->fileevent($server, 'readable', sub { my $readable_handles = new IO::Select(); $readable_handles->add($server); my $buf; while (1) { #Infinite loop # select() blocks until a socket is ready to be read or written my ($new_readable) = IO::Select->select($readable_handles, undef, undef, 0); print "Inside while \n"; # If it comes here, there is at least one handle # to read from or write to. For the moment, worry only about # the read side. foreach my $sock (@$new_readable) { print "Inside foreach $sock \n"; if ($sock == $server) { my $new_sock = $sock->accept(); # Add it to the list, and go back to select because the # new socket may not be readable yet. $readable_handles->add($new_sock); } else { # It is an ordinary client socket, ready for reading. $buf = <$sock>; if ($buf) { # .... Do stuff with $buf $$status_ref = $buf; } else { # Client closed socket. We do the same here, and remov +e # it from the readable_handles list $readable_handles->remove($sock); close($sock); } } } } } ); }

      Hi
      I even modified the server code to make it working, i removed the gui portion. Now when i am starting the server and then starting the client from another terminal , it works. However, the first time when I start client.pl, it prints msg1, then stops. Again when i start client.pl , it prints msg1 amd msg2. Similarly third time msg1, msg2,msg3 .

      My question is

      1. why not all the five messages msg1..msg5 are getting printed in one go when i start client.pl

      The client code remains as it is as posted before
      Can someone please explain me the flow of the code.

      my $server; $server = IO::Socket::INET::->new( Proto => 'tcp', LocalPort => 55555, Listen => 1, Reuse => 1 ) or die "Server can't start: $!"; my $readable_handles = new IO::Select(); my $buf; while (my $client = $server->accept) { #Infinite loop # select() blocks until a socket is ready to be read or written my ($new_readable) = IO::Select->select($readable_handles, undef, undef, 0); # print "Inside while \n"; # If it comes here, there is at least one handle # to read from or write to. For the moment, worry only about # the read side. $readable_handles->add($client); foreach my $sock (@$new_readable) { if ($sock == $server) { my $new_sock = $sock->accept(); # Add it to the list, and go back to select because the # new socket may not be readable yet. $readable_handles->add($new_sock); } else { # It is an ordinary client socket, ready for reading. $buf = <$sock>; if ($buf) { # .... Do stuff with $buf #$$status_ref = $buf; print $buf ; } else { # Client closed socket. We do the same here, and remov +e # it from the readable_handles list $readable_handles->remove($sock); #close($sock); } } } }

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://1055676]
Front-paged by Arunbear
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others taking refuge in the Monastery: (8)
As of 2014-08-29 20:20 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The best computer themed movie is:











    Results (288 votes), past polls