Tkx socket server can't read input

[Kevin Walzer]

Hello,

I'm trying to implement a simple tcp server using Tkx, based on some
sample code I've found on this mailing list and PerlMonks, and am having
some trouble. The idea is that a client script will send some data to
the server, and the server will print the data into its own display.

Here is the client script:

#!/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..5){
print $sock "$count\n";
print "$count\n";

}
close ($sock);


And the server script:

use strict;
use warnings;

use Tkx;
Tkx::package_require('tile');
my $mw = Tkx::widget->new(".");


my $server = Tkx::socket(-server => [\&new_connection], 7777);

my $log = $mw->new_tk__text(
-height => 10,
-width => 60,
-wrap => 'none'
);
$log->g_grid( -column => 0, -row => 0 );

Tkx::fconfigure($server, -blocking => 0);
#Tkx::fileevent( $server, readable => [\&new_connection, \$server] );
Tkx::MainLoop();

sub new_connection {

my $client = shift;
Tkx::fconfigure($client, -blocking => 0);
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;
my $n;
# eval { $message = Tkx::gets($client, $n); };
$message = Tkx::gets($client, $n);
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();
}
}

The server starts fine, but when I fire up the client script and send
data, the server hangs with this error message:

can not find channel named "::perl::SCALAR(0x7fa3ab87cdc8)" at
tkx-server.pl line 38.

can not find channel named "::perl::SCALAR(0x7fa3ab87cdc8)"
while executing
"gets ::perl::SCALAR(0x7fa3ab87cdc8) {}"
invoked from within
"::perl::CODE(0x7fa3ab85a878)"

The relevant line is in the hande_connection subroutine:

$message = Tkx::gets($client, $n);

The server seems to be acknowledging the connection, so I'm not clear
why it can't find a channel, nor display any data (1,2,3,4,5) sent over
the wire.

I understand that on the server side, using normal Perl sockets won't
work because they don't integrate with Tk's event loop, hence using Tcl
sockets (exposed via Tkx) is necessary; I assume this isn't an issue on
the client side. However, I'm unclear what's going on with the error.
Can anyone illuminate me?

Thanks,
Kevin

--
Kevin Walzer
Code by Kevin/Mobile Code by Kevin
http://www.codebykevin.com
http://www.wtmobilesoftware.com

--
Kevin Walzer
Code by Kevin/Mobile Code by Kevin
http://www.codebykevin.com
http://www.wtmobilesoftware.com

[Konovalov, Vadim (Vadim)** CTR **]

> Here is the client script:
>
> #!/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..5){
> print $sock "$count\n";
> print "$count\n";
>
> }

I've added here:

print $sock "quit\n";

but the script could be fixed to run even without this.

> close ($sock);
>
>
> And the server script:
>
> use strict;
> use warnings;
>
> use Tkx;
> Tkx::package_require('tile');
> my $mw = Tkx::widget->new(".");
>
>
> my $server = Tkx::socket(-server => [\&new_connection], 7777);
>
> my $log = $mw->new_tk__text(
> -height => 10,
> -width => 60,
> -wrap => 'none'
> );
> $log->g_grid( -column => 0, -row => 0 );
>
> Tkx::fconfigure($server, -blocking => 0);
> #Tkx::fileevent( $server, readable => [\&new_connection, \$server] );
> Tkx::MainLoop();
>
> sub new_connection {
>
> my $client = shift;
> Tkx::fconfigure($client, -blocking => 0);
> Tkx::fileevent( $client, readable =>[\&handle_connection, \$client]);

notice that you pass REFERENCE to scalar, hence - in the handler
that variable should be de-referenced.
Alternately, pass not the reference, but $client variable itself.
No need to have reference here.

> $log->insert( 'end', "connected\n" );
> $log->see('end');
> Tkx::update();
> }
>
> sub handle_connection {
> my ($client) = shift;
> my $message;
> my $n;
> # eval { $message = Tkx::gets($client, $n); };
> $message = Tkx::gets($client, $n);

this must be done this way:

$message = Tkx::gets($client);

According to TCL documentation:

gets channelId ?varName?

DESCRIPTION
.....
If varName is omitted the line is returned as the result of the command. If varName is specified then the line is placed in the variable by that name and the return value is a count of the number of characters returned.

you should either omit that "$n" or pass a reference to it but in this case you get returned length, not the content, hence this is not what you want....

> 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();
> }
> }
>

After these small fixes I see the communication just fine.

> I understand that on the server side, using normal Perl sockets won't
> work because they don't integrate with Tk's event loop, hence
> using Tcl
> sockets (exposed via Tkx) is necessary;

I am not socket expert, but looks like your approach with "fileevent" from Tcl side
is the good one...

Regards,
Vadim.

[Kevin Walzer]

Hi Vadim,

I've edited my server script along the lines you suggest, removing the
"update" references (because it causes Tk on my Mac to go into an
infinite loop):

use strict;
use warnings;

use Tkx;
Tkx::package_require('tile');
my $mw = Tkx::widget->new(".");


my $server = Tkx::socket(-server => [\&new_connection], 7777);

my $log = $mw->new_tk__text(
-height => 10,
-width => 60,
-wrap => 'none'
);
$log->g_grid( -column => 0, -row => 0 );

Tkx::fconfigure($server, -blocking => 0);

Tkx::MainLoop();

sub new_connection {

my $client = shift;
Tkx::fconfigure($client, -blocking => 0);
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;

$message = Tkx::gets($client);

if ( defined $message and $message !~ /^quit/ ) {
$message =~ s/[\r\n]+$//;
$log->insert( 'end', "$message\n" );
$log->see('end');
}

else {
print "connection closed\n";
$log->insert( 'end', "connection closed\n" );
$log->see('end');

$client->close();
}
}

And here's my client script again:

#!/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..5){
print $sock "$count\n";
print "$count\n";
}

close ($sock);

This doesn't display any output at all. When I add the "print $sock
'quit\n'" line to the client script, it prints this:

connected
1
connection closed

Either way, this isn't work the way I expect. Do you have any
suggestions as to what I may be doing wrong?

--Kevin

[Konovalov, Vadim (Vadim)** CTR **]

> sub handle_connection {
> my ($client) = shift;
> my $message;
> $message = Tkx::gets($client);
> if ( defined $message and $message !~ /^quit/ ) {
> $message =~ s/[\r\n]+$//;
> $log->insert( 'end', "$message\n" );
> $log->see('end');
> }
> else {
> print "connection closed\n";
> $log->insert( 'end', "connection closed\n" );
> $log->see('end');
> $client->close();
> }
> }

this works bettr:

sub handle_connection {
my ($client) = shift;

my $message = Tkx::gets($client);
if ( !Tkx::eof($client) ) {

$message =~ s/[\r\n]+$//;
$log->insert( 'end', "$message\n" );
}

else {
print "connection closed\n";
$log->insert( 'end', "connection closed\n" );

eval {Tkx::close($client);}; ## this was incorrect - $client->close();
}
$log->see('end');
}

[Kevin Walzer]

On 4/3/13 7:02 AM, Konovalov, Vadim (Vadim)** CTR ** wrote:
> sub handle_connection {
> my ($client) = shift;
> my $message = Tkx::gets($client);
> if ( !Tkx::eof($client) ) {
> $message =~ s/[\r\n]+$//;
> $log->insert( 'end', "$message\n" );
> }
> else {
> print "connection closed\n";
> $log->insert( 'end', "connection closed\n" );
> eval {Tkx::close($client);}; ## this was incorrect - $client->close();
> }
> $log->see('end');
> }

Indeed--this works better. Thank you.

This is also the solution to my earlier discussion, a month or so ago,
about using XMLRPC as a form of IPC between Tkx and other apps. Turns
out that the canonical Tcl socket approach, exposed from Perl, is not
only simpler but optimal. What a nice discovery.

Now, as soon as I get an Apple Event dispatching mechanism working via
SWIG, I think I'll be good to go in developing a Perl-Tkx app for the
Mac that is commercial quality...