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
Re: Tk with thread and stram data
by Marshall (Canon) on Dec 23, 2020 at 20:34 UTC
|
$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.
| [reply] [d/l] |
|
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
| [reply] |
|
| [reply] |
Re: Tk with thread and stram data
by tybalt89 (Monsignor) 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; }
}
| [reply] [d/l] |
|
| [reply] |
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
| [reply] [d/l] |
Re: Tk with thread and stram data ( return )
by Anonymous Monk on Dec 25, 2020 at 01:54 UTC
|
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__
| [reply] [d/l] [select] |
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. | [reply] |
Re: Tk with thread and stram data
by jmlynesjr (Deacon) 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...
| [reply] |
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? | [reply] |
Re: Tk with thread and stram data
by Anonymous Monk on Jan 04, 2021 at 19:46 UTC
|
| [reply] |
|
|