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.

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;
}
[download]

Thank you so much for your reply. I wil digest this and give it a try. I am new to perl, perlTk and the Monastrey, as you may have guessed. I will let you know soon how it went.

Arrgh.

The script I gave you above would have been great if it turned out to actually be non-blocking. That turns out not to be the case. This one however, IS non-blocking.

#!/usr/bin/perl

use strict;
use warnings;

use Tk;
use Tk::Text;
use IO::Socket;

use threads;
use threads::shared;

my $buffer : shared;
my $cancel : shared;

my ( $ip_addr, $line, $sock, $thread );

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

#$ent1->insert( 'end', 'localhost:2345' ); #for testing

MainLoop;

sub start {
    $cancel  = 0;
    $ip_addr = $ent1->get();
    print STDOUT "addr: $ip_addr\n";

    $sock = new IO::Socket::INET(
        PeerAddr => $ip_addr,
        PeerPort => '5000',
        Proto    => 'tcp',
    );
    warn "Could not create socket: $! \n" and return unless $sock;

    $thread = threads->new( \&get_lines, $sock );
    while ( !$cancel ) {
        if ( defined $buffer and length $buffer ) {
            $line   = $buffer;
            $buffer = '';
            $line =~ s/\015\012/\n/g;
            $txt->insert( 'end', $line );
            $txt->see('end');
            last if $cancel;
        }
        $mw->update;
    }
}

sub get_lines {
    my ($sock) = @_;
    while ( defined( my $line = <$sock> ) ) {
        $buffer .= $line;
        last if $cancel;
    }
    $buffer = '';
}

sub stop {
    $cancel = 1;
    $thread->detach();
    shutdown( $sock, 0 );
    close $sock;
    undef $sock;
}
[download]