> 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.
