Beefy Boxes and Bandwidth Generously Provided by pair Networks
laziness, impatience, and hubris
 
PerlMonks  

Re: Perl/Tk threading and/or cron job?

by liverpole (Monsignor)
on Sep 20, 2011 at 13:55 UTC ( #926946=note: print w/ replies, xml ) Need Help??


in reply to Perl/Tk threading and/or cron job?

Hi PhysiciSteve,

It may help us more if you show what you've tried.

Having said that, I'll give you a very simple example that may do more-or-less what you need. It starts a worker thread which calculates the localtime every minute, and passes that to the main thread through the shared variable $ltime. It's important to keep the Tk code separate from the thread code (because Tk is not thread-safe), which is why the textvariable '$lbl_label' was kept separate from $ltime, and only assigned from $ltime from within the Tk idle loop update_gui().

You can, of course, change sleep 60; to a smaller interval to see it update more often:

#!/usr/bin/perl -w # Libraries use warnings; use strict; use threads; use threads::shared; use Tk; use Tk::Font; # Shared variables my $ltime : shared = 0; # Globals my $lbl_label = "Started"; # Main Program my $thread = threads->create(\&worker_thread); $thread->detach; create_gui(); # Subroutines sub worker_thread { while (1) { $ltime = localtime(time()); print "Debug> In worker_thread(): Updated localtime to '$ltim +e'\n"; sleep 60; } } sub create_gui { my $mw = new MainWindow(-title => 'Thread example'); my $fr = $mw->Frame->pack(-expand => 1, -fill => 'both'); my $fnt = $mw->Font(-family => 'arial', -size => '12'); my $lbl = $fr->Label(-textvar => \$lbl_label, -background => '#ffe +fb5'); my $btn = $fr->Button(-text => 'Exit (ESC)', -background => 'cyan' +); $btn->configure(-command => sub { exit }, -font => $fnt); $lbl->configure(-font => $fnt); $lbl->pack(-side => 'left'); $btn->pack(-side => 'right'); $mw->bind("<Escape>" => sub { $btn->invoke }); $mw->repeat(1000 => \&update_gui); MainLoop; } sub update_gui { printf "Debug> In update_gui(): %s\n", time(); $lbl_label = $ltime; }

s''(q.S:$/9=(T1';s;(..)(..);$..=substr+crypt($1,$2),2,3;eg;print$..$/


Comment on Re: Perl/Tk threading and/or cron job?
Select or Download Code
Replies are listed 'Best First'.
Re^2: Perl/Tk threading and/or cron job?
by marioroy (Monk) on Jun 14, 2015 at 17:32 UTC

    I received a request today for running MCE with Tk and displaying a progress bar. Your post was very helpful. Thank you.

    use strict; use warnings; use threads; use threads::shared; use Tk; use Tk::Font; use Tk::ProgressBar; use MCE; # Shared variables my $percentage_completed : shared = 0.0; # Globals my $percentage_label = 0.0; my $download_label = "Completed...$percentage_completed%"; # Main Program my $mce_thread = threads->create(\&run_mce); run_gui(); # Subroutines sub indicator { my ($current_line, $total_lines) = @_; $percentage_completed = sprintf '%.1f', $current_line * 100 / $tot +al_lines; } sub run_mce { my $n=10; my $mce = MCE->new( max_workers => 1, init_relay => 0, sequence => [ 0, $n ], chunk_size => 1, user_func => sub { my ($mce, $i, $chunk_id) = @_; MCE::relay { indicator($i, $n) }; sleep 1; } )->run; } sub run_gui { my $mw = MainWindow->new(-title => 'Downloading...'); my $message = $mw->Message( -textvariable => \$download_label, -width => 130, -border => 2 )->pack(-side => 'top'); $mw->geometry('350x100'); $mw->resizable(1,0); my $progress = $mw->ProgressBar( -width => 15, -from => 0, -to => 100, -blocks => 50, #more block more smooth -gap => 1, #use 0 to get solid bar else use 1 -colors => [ 0, '#104E8B' ], -variable => \$percentage_label )->pack(-fill => 'x'); my $button = $mw->Button( -text => 'Cancel (ESC)', -command => sub { ($percentage_completed < 100.0) ? MCE::Signal::stop_and_exit('TERM') : $mw->destroy; } )->pack(-side => 'right'); $mw->bind('<Escape>' => sub { $button->invoke }); $mw->repeat(100 => \&update_gui); MainLoop; } sub update_gui { $percentage_label = $percentage_completed; $download_label = "Completed...$percentage_completed%"; }

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others cooling their heels in the Monastery: (8)
As of 2015-08-05 10:04 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The oldest computer book still on my shelves (or on my digital media) is ...













    Results (81 votes), past polls