Beefy Boxes and Bandwidth Generously Provided by pair Networks
Do you know where your variables are?
 
PerlMonks  

Tk with thread and stram data

by faustf (Novice)
on Dec 23, 2020 at 16:29 UTC ( #11125685=perlquestion: print w/replies, xml ) Need Help??

faustf has asked for the wisdom of the Perl Monks concerning the following question:

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

Replies are listed 'Best First'.
Re: Tk with thread and stram data
by Marshall (Canon) on Dec 23, 2020 at 20:34 UTC
    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.

      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
        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".

Re: Tk with thread and stram data
by tybalt89 (Prior) on Dec 24, 2020 at 00:47 UTC

    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; } }
Re: Tk with thread and stram data
by karlgoethebier (Abbot) on Dec 23, 2020 at 20:56 UTC

    See also

    «The Crux of the Biscuit is the Apostrophe»

    perl -MCrypt::CBC -E 'say Crypt::CBC->new(-key=>'kgb',-cipher=>"Blowfish")->decrypt_hex($ENV{KARL});'Help

Re: Tk with thread and stram data
by perlfan (Vicar) on Dec 23, 2020 at 19:49 UTC
    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.
Re: Tk with thread and stram data
by jmlynesjr (Chaplain) on Dec 24, 2020 at 02:41 UTC

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

    James

    There's never enough time to do it right, but always enough time to do it over...

Re: Tk with thread and stram data ( return )
by Anonymous Monk on Dec 25, 2020 at 01:54 UTC

    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__
Re: Tk with thread and stram data
by Anonymous Monk on Dec 23, 2020 at 20:36 UTC
    So you're saying the Tk thread doesnt get a chance to run because the socket thread never usleeps?
Re: Tk with thread and stram data
by Anonymous Monk on Jan 04, 2021 at 19:46 UTC

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://11125685]
Approved by Corion
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others drinking their drinks and smoking their pipes about the Monastery: (4)
As of 2021-05-17 14:25 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Perl 7 will be out ...





    Results (157 votes). Check out past polls.

    Notices?