Perl TK with Proc::Background proper usage (keep GUI active?) - perl

Question

I'm trying to build a Toplevel window that will show the progress of a system cmd. I want the GUI to be active (without freezing and "not responding"), so pressing on the "Cancel" button will kill the process, otherwise, when finished, make active the "close" button and disable the "cancel". Following a suggestion to one of my previous questions, I tried to use Proc::Background. The sole way I've found to do it is:
my $proc1;
my $cancel = $toplevel->Button(-text => "Cancel", -command =>sub{$proc1->die;})->pack;
my $close = $toplevel->Button(-text => "Close", -command =>sub{destroy $toplevel;}, -state=>"disabled")->pack;
$proc1 = Proc::Background->new("x264.exe $args");
while ($proc1->alive == 1){
$mw->update();
sleep(1);
}
$cancel->configure(-state=>'disabled');
$close->configure(-state=>'normal');
Is there another, more efficient way to do it (without waiting 1 sec for response)?
Thanks,
Mark.

Answer 1

I use Time::HiRes::usleep.
use Time::HiRes qw(usleep);
while ($proc1->alive == 1){
$mw->update();
usleep(100_000); //0.1 seconds
}
It may be an overkill for this problem, but at some point our UI applications grow and we desperately need to use high resolution timers and asynchronously dispatch and listen events thorough out the application. For this purpose I find the POE framework a great asset.
I particularly use POE with wxWidgets but it is also compatible with Tk:
POE::Loop::Tk

Answer 2

The after method (of any Tk widget) lets you schedule a callback to occur a certain number of milliseconds in the future, and the waitVariable method (you'll need to search in the page) will run the event loop until a variable is set.
my $proc1;
my $cancel = $toplevel->Button(-text => "Cancel", -command =>sub{$proc1->die;})->pack;
$proc1 = Proc::Background->new("x264.exe $args");
my $procDone = 0;
my $timercb = sub {
if ($proc1->alive) {
$toplevel->after(100, $timercb);
} else {
$procDone = 1; # Anything really
}
};
$timercb();
$toplevel->waitVariable(\$procDone) unless ($procDone);
(I'm not sure if this code will work; I don't code very much in Perl these days, so I'm translating what I'd do in another language…)