Beefy Boxes and Bandwidth Generously Provided by pair Networks
Syntactic Confectionery Delight
 
PerlMonks  

Re: Listening Socket in Tk

by zentara (Archbishop)
on May 08, 2005 at 10:48 UTC ( [id://454992]=note: print w/replies, xml ) Need Help??


in reply to Listening Socket in Tk

You can use Tk's fileevent as in the example below. Start the server, and as many clients as you want. (Not tested on Windows) and I'm not entirely sure what you want. Also alot of error checking is left out. I like to use Net::EasyTCP for this type of thing. It can be used with Tk, by the method shown by Errto, of putting the socket checking into a "repeat" statement( but that is getting away from your question. See ztk-enchat encrypted server client).
##############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 => 3, Reuse => 1, ) or die "Can't create listen socket : $!\n"; my $mw = MainWindow->new(); $mw->geometry('+20+20'); 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(); } } __END__ <code> <code> ############clients######################### #!/usr/bin/perl use warnings; use strict; use IO::Socket; $|++; my $name = 'foo'; while(1){ my $sock = new IO::Socket::INET ( PeerAddr => 'localhost', PeerPort => '7070', Proto => 'tcp', ); die "Could not create socket: $!\n" unless $sock; $sock->autoflush(1); my $con_msg = <$sock>; print $con_msg,"\n"; print $sock $name.time,"\n"; my $msg = <$sock>; print $msg; $sock->close(); sleep(5); } exit 0;

I'm not really a human, but I play one on earth. flash japh

Replies are listed 'Best First'.
Re^2: Listening Socket in Tk
by avo (Pilgrim) on May 08, 2005 at 20:31 UTC
    This is very good. It works on Linux! I was just wondering how to get this to work under Windows :( Does anyone know how to get Tk::Fileevent to work on Active Perl 5.8.3+ ? Thanks guys I realy apreciate all your input!!!
      I'm afraid that fileevent is broken on Win32. I wanted to use it to monitor a logfile in one cross-platform Tk app, but I had to resort to polling when $^O eq MSWin32. :(

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://454992]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others surveying the Monastery: (4)
As of 2024-04-25 12:37 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found