Tkx and socket
JohnD
not work. It seems to me that Tkx::fileevent is different from
Tk::fileevent. Can someone tell me what is wrong with my code? (the code
includes a (non working) server and a client (untested). Thank you.
#!/opt/ActivePerl-5.12/bin/perl
use strict;
use warnings;
use Tkx;
Tkx::package_require('tile');
my $mw = Tkx::widget->new(".");
use IO::Socket;
my $server = IO::Socket::INET->new(
LocalPort => 7777,
Type => SOCK_STREAM,
Reuse => 1,
Listen => 3
);
my $log = $mw->new_tk__text(
-height => 10,
-width => 60,
-wrap => 'none'
);
$log->g_grid( -column => 0, -row => 0 );
Tkx::fileevent( $server, readable => [\&new_connection, \$server] );
Tkx::MainLoop();
sub new_connection {
my $listen = shift;
my $client = $listen->accept() or warn "Can't accept connection";
$client->autoflush(1);
Tkx::fileevent( $client, readable =>[\&handle_connection, \$client]
);
$log->insert( 'end', "connected\n" );
$log->see('end');
Tkx::update();
}
sub handle_connection {
my ($client) = shift;
my $message = <$client>;
if ( defined $message and $message !~ /^quit/ ) {
$message =~ s/[\r\n]+$//;
$log->insert( 'end', "$message\n" );
$log->see('end');
Tkx::update();
}
else {
print "connection closed\n";
$log->insert( 'end', "connection closed\n" );
$log->see('end');
Tkx::update();
$client->close();
}
}
#!/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);
smallpond
> I want a tcp server with a Tkx interface. I made some code but this does
> not work. It seems to me that Tkx::fileevent is different from
> Tk::fileevent. Can someone tell me what is wrong with my code? (the code
> includes a (non working) server and a client (untested). Thank you.
>
I have looked through a lot of code over the years and have yet to see
the error message "doesn't work". The folks who wrote the code
included
returns in all of the calls to tell you exactly what failed, but
you have elected not to check any return codes or describe any of the
error messages that resulted from running your code.
Too bad for you.
As for the answer to your question: Yes - Perl could tell you what is
wrong with your code but you don't seem to be listening.
Add checks on every call to see if it worked or to print out all
available information when it fails. Come back with something
useful if you can't get any further.
$Bill
> I want a tcp server with a Tkx interface. I made some code but this does
> not work. It seems to me that Tkx::fileevent is different from
> Tk::fileevent. Can someone tell me what is wrong with my code? (the code
> includes a (non working) server and a client (untested). Thank you.
I haven't figured out the proper way to handle sockets in an event driven
env, but I'm using something like this till I do:
while (1) {
if (Tk::MainWindow->Count) {
DoOneEvent (0); # handle any window events
}
<check my socket IO can_read/can_write and process circuits>
<sometimes I'll use a Q between the from and back side and
process the Qs here in the main loop>
<do a 100 msec or so sleep if nothing happening - to release control to others>
}
JohnD
> On Mar 18, 10:45 am, JohnD <j...@nowhere.com> wrote:
>
> I have looked through a lot of code over the years and have yet to see
> the error message "doesn't work". The folks who wrote the code
> included
> returns in all of the calls to tell you exactly what failed, but
> you have elected not to check any return codes or describe any of the
> error messages that resulted from running your code.
>
> Too bad for you.
Sorry for the ommision. here it is:
can not find channel named "IO::Socket::INET=GLOB(0x959cd38)" at
./spshow_simple2.pl line 24.
Line 24: Tkx::fconfigure($server, -blocking => 0);
JohnD
> On 3/18/2011 6:45 AM, JohnD wrote:
> I haven't figured out the proper way to handle sockets in an event driven
> env, but I'm using something like this till I do:
>
> while (1) {
Thank you for this code. I will give it a try.
$Bill
Forgot to mention - that was Tk not Tkx I was using.
smallpond
That's quite an omission given that fconfigure isn't
in your code.
If you're trying to make a socket non-blocking have
you considered doing select with timeout = 0?
Of course, feel free to diverge from years of
accepted practice.
JD
> On Mar 19, 5:22 am, JohnD <j...@somewhere.com> wrote:
>> On 2011-03-18, smallpond <smallp...@juno.com> wrote:
>> > On Mar 18, 10:45 am, JohnD <j...@nowhere.com> wrote:
>> [...]
> If you're trying to make a socket non-blocking have
> you considered doing select with timeout = 0?
> Of course, feel free to diverge from years of
> accepted practice.
This may all be true, but I've been trying to get working code for days
now. 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)
$Bill
>
> Who can help me producing a working program on Windows?
Try the code below - run it in one console with no args (server), then
run it in another with any arg (client). I left only the Win32 code,
but I don't see why it wouldn't also run in UNIX.
use strict;
use warnings;
use Tk;
use IO::Select;
use IO::Socket;
$| = 1;
my $c = 0; $c = 1 if @ARGV; # client sets something in ARGV
my $sel_set = IO::Select->new;
if ($c) { do_client (); }
if (not $c) { do_server (); }
exit;
my ($mw, $tb, $listen);
#- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub do_server {
# open listen endpoint
$listen = IO::Socket::INET->new(
Proto => 'tcp',
LocalAddr => '127.0.0.1',
LocalPort => 7777,
Listen => 5,
Reuse => 1,
) or die "listen: $! ($^E)";
printf "listen on %s\n", fileno $listen;
$sel_set->add($listen);
# create window
$mw = MainWindow->new();
# create scrolled text window
$tb = $mw->Scrolled('Listbox', -scrollbars => 'ose',
-font => '-*-Courier-Medium-R-Normal--*-120-*-*-*-*-*-*',
-relief => 'sunken', -width => 80, -height => 8, -setgrid => 1,
)->pack(-side => 'bottom', -fill => 'both', -expand => 1);
$tb->insert('end', "Starting processing");
print "Starting processing\n";
# periodically call process
$mw->repeat(50, [\&process]);
# start Tk main loop
Tk::MainLoop;
exit;
}
#- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub process {
my @ready = $sel_set->can_read(0);
return if not @ready;
foreach my $S (@ready) {
# see if inbound connect to listen socket
if ($S == $listen) {
do_accept ($S); next;
}
# must be an active client - read message
my $message = <$S>;
if (defined $message and $message !~ /^quit/) {
chomp $message;
$tb->insert('end', "MSG: [$message]");
} else {
$tb->insert( 'end', "Connection Closed" );
$sel_set->remove($S); # drop from select set
$S->close;
}
}
}
#- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub do_accept {
# see if circuit available to accept on listen socket
$tb->insert('end', "Accepting circuit");
my $client = $listen->accept or die "accept: $! ($^E)";
# create a select mask for client and setup periodic call to process
$sel_set->add($client);
my $raddr = $client->sockhost;
my $rport = $client->sockport;
$tb->insert('end', "Connected to $raddr:$rport");
}
#- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub do_client {
print "Client starting\n";
my $machine_addr = 'localhost';
my $S = new IO::Socket::INET(
PeerAddr => $machine_addr,
PeerPort => 7777,
Proto => 'tcp',
) or die "connect: $! ($^E)";
my ($rport, $raddr) = sockaddr_in ($S->peername);
print "Connected to $raddr, $rport\n";
foreach my $count(1..100) {
print $S "$count\n";
# print "$count\n";
# select (undef, undef, undef, .1);
# Win32::Sleep(100); # .1s delay
}
print $S "quit\n";
print "quit\n";
$S->close;
}
__END__
smallpond
Ah Windows. Windows doesn't have sockets. It has something
called "Winsock 2". Information here:
http://msdn.microsoft.com/en-us/library/ms740673(v=vs.85).aspx
Note that even the URL is non-standard. See perlport.
Its a pain to do a server on an OS that doesn't have fork.
$Bill
>
> Ah Windows. Windows doesn't have sockets. It has something
> called "Winsock 2". Information here:
> http://msdn.microsoft.com/en-us/library/ms740673(v=vs.85).aspx
> Note that even the URL is non-standard. See perlport.
>
> Its a pain to do a server on an OS that doesn't have fork.
It's not that hard for a normal server that can do all the work
itself. It's harder to do it properly/efficiently inside an event
driven GUI though.
Jeff Hobbs
> I want a tcp server with a Tkx interface. I made some code but this does
> not work. It seems to me that Tkx::fileevent is different from
> Tk::fileevent. Can someone tell me what is wrong with my code? (the code
> includes a (non working) server and a client (untested). Thank you.
Tkx varies from Tk in that Tkx embeds Tcl while Tk rewrote the Tcl
parts, so its fileevent would have to be based off something directly
in Perl.
I'm not sure you can easily mix Tkx::fileevent and Perl sockets, but
you could rely on the features that Tcl has, exposed through Tkx.
That would be something like:
my $server = Tkx::socket(-server => [\&accept_connection], 7777);
sub accept_connection {
# may need to shift off magic handle first
my ($sock, $addr, $port) = @_;
Tkx::fconfigure($sock, -blocking => 0);
# Pass in reasonable output, eof and abnormal condition handlers
Tkx::fileevent($sock, readable => [\&fileevent_cmd_handler,
$sock, $output_cmd, $eof_cmd, $abnormal_cmd]);
}
BEGIN {
# Declare $buf outside the function so that we pass the same
# reference to Tcl each time. With a lexical we would create
# new references and new Tcl bindings each time.
my $buf;
sub fileevent_cmd_handler {
my($fh, $output_cmd, $eof_cmd, $abnormal_cmd) = @_;
my $n;
eval { $n = Tkx::gets($fh, \$buf); };
if ($@) {
# call eof_cmd if abnormal_cmd hasn't been specified,
# otherwise just call the abnormal_cmd.
&$eof_cmd($fh) if $eof_cmd && !$abnormal_cmd;
&$abnormal_cmd("$!", $fh) if $abnormal_cmd;
eval { Tkx::close($fh); };
return;
}
if ($n == -1) {
if (Tkx::eof($fh)) {
&$eof_cmd($fh) if $eof_cmd;
eval {Tkx::close($fh);};
&$abnormal_cmd("$!", $fh) if $@ && $abnormal_cmd;
}
return;
}
&$output_cmd($buf, $fh) if $output_cmd;
}
} # BEGIN
Th fileevent handle we use ourselves. It's a generic tying function
between Tcl and Perl, and should satisfy most of your needs.
Jeff