On 2011-03-26, at 2:13 AM, vwf wrote:
> I try to get a Tkx application working with a socket. In Tk you can do
> this with
>
> my $server = IO::Socket::INET->new( LocalPort => 7777,
> Type => SOCK_STREAM, Reuse => 1, Listen => 10 );
> $mw->fileevent($server, 'readable', sub { new_connection($server) });
>
> Can anyone tell me how to do this the Tkx way?
Tkx requires that you use Tkx-based (Tcl) sockets. Something along these lines
(not tested):
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
The fileevent handler we use ourselves. It's a generic tying function
between Tcl and Perl, and should satisfy most of your needs.
Jeff
