In general, it is difficult to have Tk and fork in the same script. Not impossible, but difficult. You probably will need to fork the process before generating any Tk widgets.

Is it entirely necessary to fork though? Here is a simple forking socket server (copied from Perl interprocess comunications and lightly modified to send the local time 5 times a second.) Invoke it with the port to use: defaults to 2345.

#!/usr/bin/perl use strict; BEGIN { $ENV{PATH} = '/usr/ucb:/bin' } use Socket; use Carp; use Time::HiRes; my $EOL = "\015\012"; sub spawn; # forward declaration sub logmsg { select STDERR; warn "$0 $$: @_ at ", scalar localtime +, "\n" } my $port = shift || 2345; my $proto = getprotobyname('tcp'); ($port) = $port =~ /^(\d+)$/ or die "invalid port"; socket( Server, PF_INET, SOCK_STREAM, $proto ) || die "socket: $!" +; setsockopt( Server, SOL_SOCKET, SO_REUSEADDR, pack( "l", 1 ) ) || die "setsockopt: $!"; bind( Server, sockaddr_in( $port, INADDR_ANY ) ) || die "bind: $!" +; listen( Server, SOMAXCONN ) || die "listen: $!"; logmsg "server started on port $port"; my $waitedpid = 0; my $paddr; use POSIX ":sys_wait_h"; use Errno; sub REAPER { local $!; # don't let waitpid() overwrite current error while ( ( my $pid = waitpid( -1, WNOHANG ) ) > 0 && WIFEXITED( +$?) ) { logmsg "reaped $waitedpid" . ( $? ? " with exit $?" : '' ) +; } $SIG{CHLD} = \&REAPER; # loathe sysV } $SIG{CHLD} = \&REAPER; while (1) { $paddr = accept( Client, Server ) || do { # try again if accept() returned because a signal was rece +ived next if $!{EINTR}; die "accept: $!"; }; my ( $port, $iaddr ) = sockaddr_in($paddr); my $name = gethostbyaddr( $iaddr, AF_INET ); logmsg "connection from $name [", inet_ntoa($iaddr), "] at por +t $port"; spawn sub { select Client; $| = 1; while (1) { my $time = scalar localtime; print Client "Hello there, $name, it's now $time $EOL" +; Time::HiRes::sleep .2; } }; close Client; } sub spawn { my $coderef = shift; unless ( @_ == 0 && $coderef && ref($coderef) eq 'CODE' ) { confess "usage: spawn CODEREF"; } my $pid; if ( !defined( $pid = fork ) ) { logmsg "cannot fork: $!"; return; } elsif ($pid) { logmsg "begat $pid"; return; # I'm the parent } # else I'm the child -- go spawn open( STDIN, "<&Client" ) || die "can't dup client to stdin"; open( STDOUT, ">&Client" ) || die "can't dup client to stdout" +; ## open(STDERR, ">&STDOUT") || die "can't dup stdout to stderr +"; exit &$coderef(); }

Then use this script to connect to it and display the received data. (connect to localhost:port if the server is on the same machine or the servers IP:port if remote.)

This is not completely non-blocking, it updates 10 times a second though so it is pretty responsive.

UPDATE: This is not non-blocking at all :(. See updated script below.

#!/usr/bin/perl use strict; use warnings; use diagnostics; use Tk; use Tk::Text; use IO::Socket; my ( $ip_addr, $line, $sock, $afterid, $cancel ); my $mw = new MainWindow; # Put a Frame in it/give it a label my $frm_name = $mw->Frame(); my $lab = $frm_name->Label( -text => "Enter IP address:port" ); # We need entry boxes for IP address:socket & a button to start runnin +g. my $ent1 = $frm_name->Entry(); my $but = $mw->Button( -text => "Start", -command => \&start ); my $stopbut = $mw->Button( -text => "Stop", -command => \&stop ); # Create a window for Display and Input. my $textarea = $mw->Frame(); #creating another frame my $txt = $textarea->Scrolled( 'Text', -width => 80, -height => 10, -scrollbars => 'osoe' ); $lab->grid( -row => 1, -column => 1 ); $ent1->grid( -row => 1, -column => 2 ); $frm_name->grid( -row => 1, -column => 1, -columnspan => 2 ); $but->grid( -row => 4, -column => 1 ); $stopbut->grid( -row => 4, -column => 2 ); $txt->grid( -row => 1, -column => 1 ); $textarea->grid( -row => 5, -column => 1, -columnspan => 2 ); MainLoop; sub start { return if defined $afterid; $cancel = 0; $ip_addr = $ent1->get(); print STDOUT "addr: $ip_addr\n"; $sock = new IO::Socket::INET( PeerAddr => $ip_addr, PeerPort => '5000', Proto => 'tcp', ); die "Could not create socket: $! \n" unless $sock; $afterid = $mw->after( 100, sub { while ( defined( $line = <$sock> ) ) { $line =~ s/\015\012/\n/; $txt->insert( 'end', $line ); $txt->see('end'); $mw->update; last if $cancel; } } ); } sub stop { return unless $afterid; $cancel = 1; $afterid->cancel; undef $afterid; close $sock; undef $sock; }

In reply to Re: How to redirect socket output to Tk widget by thundergnat
in thread How to redirect socket output to Tk widget by zapo

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.