senthilkumarperl has asked for the wisdom of the Perl Monks concerning the following question:

Hi

I have problem in TK module.I am making connection between two system using tcp socket.I am using Tk module as front end.I used these program for chating between two system.After executing my client and server program.My Tk module window is hanged .See my code any help would be appreciated

This is server program

use IO::Socket;
use Tk;

$| = 1;

$socket = new IO::Socket::INET (
                LocalHost => '10.101.3.55',
                LocalPort => '5000',
                Proto => 'tcp',
                Listen => 5,
                Reuse => 1
                );
die "Coudn't open socket" unless $socket;
print "\nTCPServer Waiting for client on port 5000";
while(1)
{
    $client_socket = "";
    $client_socket = $socket->accept();
    $peer_address = $client_socket->peerhost();
    $peer_port = $client_socket->peerport();
    print "\n I got a connection from ( $peer_address , $peer_port ) "
+;
    my ($txt,$mw,$frm_name,$lab,$ent,$txt,$but);
    $mw= MainWindow->new();
        while(1){
        #$mw->messageBox(-message=>"TCPServer Waiting for client on po
+rt 5000");
        $frm_name = $mw -> Frame() -> pack();
        $lab = $frm_name -> Label(-text=>"Name:") -> pack();
        $ent = $frm_name -> Entry() -> pack();
        $txt = $mw -> Text(-width=>40, -height=>10) -> pack();
        $but = $mw -> Button(-text=>"Push Me", -command =>sub {
            while (1)
            {
            # print "\n SEND( TYPE q or Q to Quit):";
            my $send_data =  $ent -> get();
            chop($send_data); 
            if ($send_data eq 'q' or $send_data eq 'Q')
            {
            $client_socket->send ($send_data);
            close $client_socket;
            last;
            }
            else
            {
            $client_socket->send($send_data);
            }
            $client_socket->recv($recieved_data,1024);
            if ( $recieved_data eq 'q' or $recieved_data eq 'Q')
            {
            close $client_socket;
            last;
            }
            else
            {
            #print "\n RECIEVED: $recieved_data";
            my $data=$recieved_data;
            $txt -> insert('end',"$data");
            }
        }
        } )-> pack();
        #$but-> pack();

        Tk::MainLoop;
        }
}

[download]

This is my client program


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



$socket = new IO::Socket::INET (
                                  PeerAddr  => '10.101.3.55',
                                  PeerPort  =>  5000,
                                  Proto => 'tcp',
                               )                
or die "Couldn't connect to Server\n";
die "Could not connect: $!" unless $socket;
my ($txt,$mw,$frm_name,$lab,$ent,$txt,$but);
$mw= MainWindow->new();
while (1)
{
    #print "hi\n";
    $socket->recv($recv_data,1024);
    
    if ($recv_data eq 'q' or $recv_data eq 'Q')
    {
        close $socket;
        last;
    }
else
{
        $frm_name = $mw -> Frame() -> pack();
        $lab = $frm_name -> Label(-text=>"Name:") -> pack();
        $ent = $frm_name -> Entry() -> pack();
        $txt = $mw -> Text(-width=>40, -height=>10) -> pack();
        print "RECIEVED: $recv_data"; 
        my $data=$recv_data;
        
        $but = $mw -> Button(-text=>"Push Me", -command =>sub {
        
        #print "\nSEND( TYPE q or Q to Quit):";
        $txt -> insert('end',"$data");
        $send_data = $ent -> get();
        chop($send_data);
              
        
        if ($send_data ne 'q' and $send_data ne 'Q')
        {
            $socket->send($send_data);
        }    
        else
        {
            $socket->send($send_data);
            close $socket;
            last;
        }
        
    })->pack();
    Tk::MainLoop;
    }
}

[download]

Senthil

Replies are listed 'Best First'.
Re: hanged In Tk-socket program
by zentara (Cardinal) on Jun 09, 2011 at 15:24 UTC
    Your program has while(1) loops in it, and that interferes with the Tk event loop. It is badly written for Tk purposes, but you may be able to salvage it by putting $mw->update; in your while(1) loop, but no guarantee.

    Here is the way to do it within Tk, use fileevent.

    The server 

    #!/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   => 7070,
    Listen      => 1,
    Reuse       => 1,
) or die "Can't create listen socket : $!\n";

my $mw = MainWindow->new();

my $text = $mw->Scrolled('Text',
                  -background =>'black',
          -foreground => 'yellow',
             )->pack();      

my $subframe = $mw->Frame()->pack();

$subframe->Button(-text => 'Clear',
         -command => sub {
                  $text->delete('1.0','end');
           })->pack(-side=>'left');

$subframe->Button(-text => 'Save Log',
         -command => sub {   })->pack(-side=>'left');

$subframe->Button(-text => 'Exit',
         -command => sub { exit  })->pack(-side=>'right');
                           
                           
$mw->fileevent($listen, 'readable', sub { new_connection($listen) });

Tk::MainLoop;

sub new_connection {
    my ($listen) = @_;
    my $client = $listen->accept() or warn "Can't accept connection";
    $client->autoflush(1);
    $mw->fileevent($client, 'readable', sub { handle_connection($clien
+t) });
    $client->print("Connected\n");
    $text->insert('end', "Connected\t");
    $text->see('end');
}

sub handle_connection {
    my ($client) = @_;
    my $message = <$client>;
    if (defined $message and $message !~ /^quit/) {
     $message =~ s/[\r\n]+$//;
     $client->print("Got message [$message]\n"); #echo back if wanted
     $text->insert('end', "Got message [$message]\t");
     $text->see('end');
    }
    else {
       $text->insert('end', "Connection Closed\n");
       $text->see('end');
       $client->close();
    }
}

    [download]
    A simple client ( minimally tested ) but shows the idea. 
    #!/usr/bin/perl
use warnings;
use strict;
use Tk;
use IO::Socket;
require Tk::ROText;

# create the socket

my $host = shift || 'localhost';
my $port = 7070;

my $socket = IO::Socket::INET->new(
       PeerAddr => $host,
       PeerPort => $port,
       Proto    => 'tcp',
      );

defined $socket or die "ERROR: Can't connect to port $port on $host: $
+!\n";

print STDERR "Connected to server ...\n";

my $mw  = new MainWindow;
my $log = $mw->Scrolled(qw/ROText -scrollbars ose/)->pack;

my $txt = $mw->Entry()->pack(qw/-fill x -pady 5/);

$mw ->bind('<Any-Enter>' => sub { $txt->Tk::focus });
$txt->bind('<Return>' => [\&broadcast, $socket]);

$mw ->fileevent($socket, readable => sub {
                    my $line = <$socket>;
                      unless (defined $line) {
                       $mw->fileevent($socket => readable => '');
                       return;
                       }
         $log->insert(end => $line);
  });


MainLoop;

sub broadcast {
    my ($ent, $sock) = @_;

    my $text = $ent->get;
    $ent->delete(qw/0 end/);

    print $sock $text, "\n";
}

    [download]
    I'm not really a human, but I play one on earth.
    Old Perl Programmer Haiku ................... flash japh
[reply]
[d/l]
[select]

Back to Seekers of Perl Wisdom