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]

In reply to Re^3: 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.