I have a Perl script running on version 5.10 build 1004 of ActiveStates Active Perl on windows xp which creates a UI and then runs a long process after a button press. During this process I would like to update the UI (a list box) with status on what is going on during the execution of this thread. Here is a stripped down version of the code.
#!/usr/local/bin/perl
use warnings;
use strict;
use Tkx;
use threads;
use threads::shared;
my $outputText = " {a} {b}";
my $mw = Tkx::widget->new(".");
$mw->g_wm_title("MD5 Checker");
$mw->g_wm_minsize(300,200);
my $content = $mw->new_ttk__frame(-padding => "12 12 12 12");
my $btnCompare = $content->new_ttk__button(-text => "Compare", -command => sub{startWork()});
my $lstbxOutput = $content->new_tk__listbox(-listvariable => \$outputText, -height => 5);
my $scollListBox = $content->new_ttk__scrollbar(-orient => 'vertical', -command => [$lstbxOutput, 'yview']);
$lstbxOutput->configure(-yscrollcommand => [$scollListBox, 'set']);
sub startWork()
{
print "Starting thread \n";
my $t = threads->create(\&doWork, 1);
sleep (5);
print $outputText . "\n";
}
sub doWork()
{
for (my $a = 0; $a<10; $a++)
{
$outputText .= " {$a}";
print "Counting $a\n";
sleep(2);
}
print "End thread\n";
}
Currently the print commands are for my debugging so I know what the main and child threads are doing. From what I have read about threading I need the use threads::shared;
to allow threads to share variables. At the moment my list box does not update at all during the child threads execution nor when the thread has ended. Without the threading, the list box would update after the main thread was done with the loop. What am I missing to get the UI to update during the threads execution?
Thanks
Wesley
One problem is that the listbox variable needs to be shared between the threads. Tk doesn't seem happy with the listbox variable shared directly, so I made two copies, and set up a periodic status update to copy the shared version to the non-shared version.
However, using threads with Tkx may be dicey. I was getting segfaults when I tried to
join
the thread rather thandetach
it, and I get a segfault with the code below if I movemy $t
insidestartWork()
. This discussion suggests that you may need to start the thread before creating any Tk widgets for it to work reliably.Here is the code I ended up with: