Tk with thread and stram data

[faustf]

hi Monks , i try to find a solution of my scenario. i have a stream source of string data , i capture with perl and i want show it in list widget , in Tk , in windows 10 and strawberry (last version ) perl 5 i have created this code but i dont know why , the script work correctly only one time and after not upgrade a string inside of Tk any one can help me ?

use warnings;
use strict;
use threads;
use threads::shared;

my $ret:shared = 0;
my $die:shared = 0;;

my $val = 0;

#create thread before any tk code is called
my $thr = threads->create( \&worker );

use Tk;
use IO::Socket::INET;

my $mw = MainWindow->new();
$mw->protocol('WM_DELETE_WINDOW' => sub { &clean_exit }); 

my $label = $mw->Label(
         -width => 50,
         -textvariable => \$val )->pack();

my $button;
$button = $mw->Button(
      -text => 'Stop thread',
       -command => sub{
        $button->configure(-state=>'disabled');
        $die = 1;
       $thr->join;
      },
     )->pack();

 
my $timer = $mw->repeat(10,sub{
              $val = $ret;
             });

MainLoop;

sub clean_exit{
 $timer->cancel;

my @running_threads = threads->list;
if (scalar(@running_threads) < 1){print "\nFinished\n";exit}
  else{
     $die = 1;
     $thr->join;
     exit;
  }
}

# no Tk code in thread

sub worker {
    # auto-flush on socket
    $| = 1;

# creating a listening socket
my $socket = new IO::Socket::INET (
    LocalHost => '127.0.0.1',
    LocalPort => '23456',
    Proto => 'tcp',
    Listen => 5,
    Reuse => 1
);
die "cannot create socket $!\n" unless $socket;
print "server waiting for client connection on port 23456 \n";

while(1)
{
    # waiting for a new client connection
    my $client_socket = $socket->accept();

    # get information about a newly connected client
    my $client_address = $client_socket->peerhost();
    my $client_port = $client_socket->peerport();
    print "connection from $client_address:$client_port\n";

    # read up to 1024 characters from the connected client
    my $data = "";
    $client_socket->recv($data, 1024);
    print "received data: $data\n";
 
    $ret = $data;

   my  @data_array = split(/;/,$data);
    foreach (@data_array) {
        return "$_\n";
      print "$_\n";
    }

    # write response data to the connected client
    $data = "ok";
    $client_socket->send($data);

    # notify client that response has been sent
    shutdown($client_socket, 1);
}

$socket->close();
}

thanks at all

[Marshall]

Tk is not thread safe. I'm not sure that any kind of process that uses threads and Tk will "get along".

It looks like to me that you are executing thread code from a Tk button:

$button = $mw->Button(
      -text => 'Stop thread',
       -command => sub{
        $button->configure(-state=>'disabled');
        $die = 1;
       $thr->join;
      },
     )->pack();

It has been years since I thought using Tk as the display for distributed client processes connected to a central DB server process. I never implemented the code - but did investigate some possibilities. I think your process that runs Tk cannot have any threads in it at all. If such a thing is possible, I'd also like to hear about it! In my architecture, the central DB server process would not have had any UI. Clients would connect and send/display stuff from the central DB process. With Tk, you have to be mindful not to have any blocking I/O in the Tk process- otherwise the GUI will hang and become unresponsive. I seem to remember that there is way to schedule a periodic fast executing task from within Tk. This is sufficient to manage a TCP connection, but you have to test if the socket has data waiting to be read before reading it (can't wait indefinitely).

I seem to remember that on Windows, Perl does a fork emulation using threads. How that would affect Tk is unknown to me. In my abandoned project, The central process would have run on Unix with traditional forking to a separate process for each connection. Each client would have been a single process running Tk on a Windows machine. I don't know if you will be forced into a connection server running threads and the Tk GUI in a separate process or not? That could be true if the threads have to do any significant amount of work.

[faustf]

not execute thread with button you can also remove button of my example inspire me this post https://www.perlmonks.org/?replies=1;displaytype=print;node_id=732294 but i dont know why for me , reply only one time in tk

[Marshall]

Interesting posts in the thread that you referenced. I didn't have time to run any actual code, but it appears to me that in one post, Tk as running in one thread and a single worker in another thread. Communication between the two threads was via shared memory with a simple lock mechanism. "msg ready" only set by the worker thread and only cleared by the Tk thread. The worker wouldn't be able send another message until the Tk thread clears the shared memory semaphore "msg ready" flag.

I suspect that there is an answer where the Tk thread polls a shared memory structure every 100 ms or so and accepts work if there is any to be done. Tk cannot wait at an exchange indefinitely or the other GUI buttons will "hang".

[tybalt89]

I don't have Windows, so good luck trying this. It does work on an ArchLinux system, that is, if I correctly understand what you are trying to do.

#!/usr/bin/perl

use strict; # https://perlmonks.org/?node_id=11125685
use warnings;
use Tk;
use IO::Socket;

my $listen = new IO::Socket::INET (
    LocalHost => '127.0.0.1',
    LocalPort => '23456',
    Proto => 'tcp',
    Listen => 5,
    Reuse => 1
) or die "cannot create listen socket $@\n";
warn "server waiting for client connection on port 23456 \n";

my $val = 0;
my $client;
my $mw = MainWindow->new();
my $label = $mw->Label( -width => 50, -textvariable => \$val,)->pack()
+;

my $button;
$button = $mw->Button( -text => 'Stop input', -command => sub 
  {
  $button->configure(-state=>'disabled');
  close $client;
  close $listen;
  }, )->pack();

$mw->fileevent( $listen, 'readable', \&newcon );

MainLoop;

sub newcon
  {
  $client = $listen->accept;
  $mw->fileevent($client, 'readable', \&getdata );
  }

sub getdata
  {
  if( sysread $client, my $buf, 1024 )
    {
    warn "received data: $buf\n";
    $val = $buf =~ tr/\n//dr;
    $client->send('ok'); # write response data to the connected client
    shutdown($client, 1); # notify client that response has been sent
    }
  else { close $client; }
  }

[Anonymous Monk]

Tk fileevent doesnt work on windows, Re^6: Client/Server sockets with TK on Win32

[karlgoethebier]

See also

[Anonymous Monk]

Hi

What does "return" do inside a subroutine? It does the same thing inside a thread right?

So

        my @data_array = split( /;/, $data );
        foreach (@data_array) {
            return "$_\n";  ##########################################
+#####################
            print "$_\n";
        }

Here is an update of Re: Parallel download Tk ( threads Thread::Queue LWP::UserAgent WWW::Mechanize)

#!/usr/bin/perl --
## perltidy -olq  -csc -csci=10 -cscl="sub : BEGIN END" -otr -opr -ce 
+-nibc -i=4 -pt=0   "-nsak=*"
use strict;
use warnings;
use threads stack_size => 4096;
use Thread::Queue;

Main( @ARGV );
exit( 0 );

sub Main {
    my $qin  = Thread::Queue->new(); ## jobs to do in background
    my $qout = Thread::Queue->new(); ## results for gui in foreground
    
## don't wait for background downloading service workers / mechtitles
    threads->create( \&mechtitles, $qin, $qout ) for 1 .. 2;
    
    tkgui($qin, $qout ); ## run gui in main thread, wait for it to fin
+ish

    return;
} ## end sub Main

sub mechtitles {
    my( $qin, $qout ) = @_;
    
    eval { threads->detach() } ;    ## can't join this thread it retur
+ns nothing :)
    
    require WWW::Mechanize;
    require Time::HiRes;
    
    my $gets = 0;
    while( 1 ) {
#~         if( defined( my $url = $qin->popnow ) ) {
        if( defined( my $url = $qin->pop ) ) {
            my $ua = WWW::Mechanize->new( autocheck => 0 );
            $ua->get( $url );
            my $title = eval { $ua->title };
            $title ||= $ua->res->status_line;
            $gets++;
            my $worker = sprintf 'worker(%s)(%s)', threads->tid, $gets
+;
            $qout->push( "$worker $url =>\n   $title\n" );
        }
        Time::HiRes::usleep( 33 * 1000 );
## sleep microseconds
## be "nice" give other thread a time slice
    }
} ## end sub mechtitles

sub tkgui {
    my( $qin, $qout ) = @_;

    require Tk;
#~     require Tk::ROText;

    my $mw = Tk::tkinit();

    my $pending = "";
    my $l = $mw->Label( -textvariable => \$pending )->pack;

#~     my $t = $mw->ROText()->pack;
    my $t = $mw->Text()->pack;

    my $b = $mw->Button( -text => 'enqueue another 4 example.com', )->
+pack;

    $b->configure( -command => [ \&q_pusher, $b, $qin, \$pending ], );

    $b->focus;

    $mw->repeat(
        100,    ## milliseconds 
        [ \&pop_to_pending, $t, \$pending, $qin, $qout, ],
    );

    $mw->MainLoop;

    return;
} ## end sub tkgui

sub q_pusher {
    my( $b, $qin, $pending ) = @_;
    $qin->push( 'http://example.com' ) for 1 .. 4;
#~     $b->configure( -state => "disabled" );
    return;
}

sub pop_to_pending {
    my( $t, $pending, $qin, $qout ) = @_;
    $$pending = 'Jobs awaiting workers ' . $qin->pending;
    if( defined( my $item = $qout->popnow ) ) {
        $t->insert( q!end!, join( '', $item ) );
        $t->see('end');
    }
    $$pending = 'Jobs awaiting workers ' . $qin->pending;
    $t->update;
    return;
}

sub Thread::Queue::append { goto &Thread::Queue::enqueue }
sub Thread::Queue::remove { goto &Thread::Queue::dequeue }
sub Thread::Queue::push   { goto &Thread::Queue::enqueue }
sub Thread::Queue::shift  { goto &Thread::Queue::dequeue }
sub Thread::Queue::popnow { goto &Thread::Queue::dequeue_nb }
sub Thread::Queue::pop    { goto &Thread::Queue::dequeue }

__END__

[perlfan]

Does this work outside of your use of Tk. I recommend reproducing this issue without Tk, unless you have tried and are sure it can't. Might be more of a threads issue than Tk.

[jmlynesjr]

Somewhere in the bowels of the Monastery is an example of using Wx with threads. It might be food for thought.

James

[Anonymous Monk]

So you're saying the Tk thread doesnt get a chance to run because the socket thread never usleeps?

[Anonymous Monk]

Hi, Tk can be used with threads with precautions. See controlling threads with Tk: while loop vs. signals