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

Hi Monks,

I want a Tk program to perform a subroutine that takes a few seconds when a button is pushed. But I don't want to wait on the the subroutine before returning control to the mainloop. When the subroutine finishes I want it to update the title on the button.

So in the below example, when the button is clicked, I want the button label to immediately update to "step two", then whenever the function finishes, to update to step 3, rather than tie up control while waiting for the function to finish.

How can I do this? 

use Tk;                                                               
+                                          
                                                                      
+                                          
$main = MainWindow->new();                                            
+                                          
                                                                      
+                                         
$button = $main->Button(-text => "step one", -command => \&fun);
                                                                      
+                                          
$button->pack();                                                      
+                                         
                                                                      
+                                          
MainLoop();                                                           
+                                          
                                                                      
+                                          
sub fun {
 $button->configure(-text => "step two" );
 sleep 1;
 $button->configure(-text => "step three" );
}

[download]

Replies are listed 'Best First'.
Re: how to fork & join in tk?
by kcott (Archbishop) on Apr 23, 2017 at 05:46 UTC

    G'day redss,

    There's no need to use fork (or anything like that). The functionality you want is built in. Take a look at Tk::after.

    There's a number of ways to use this. From your description, the non-blocking form you'll want in this case will probably be: 

    $id = $widget->after(ms?,callback?)

    [download]

    See that documentation for more details. Note the time is in milliseconds. The $id is only needed if you subsequently want to use $id->time(?delay?).

    — Ken

[reply]
[d/l]
[select]
Re: how to fork & join in tk?
by tybalt89 (Monsignor) on Apr 23, 2017 at 16:31 UTC

    Tk::IO lets you run another process and get callbacks for its output and completion. 

    #!/usr/bin/perl

# http://perlmonks.org/?node_id=1188639

use strict;
use warnings;
use Tk;
use Tk::IO;

my $status = 'startup';

my $mw = MainWindow->new;
$mw->geometry('+700+400');

$mw->Label( -textvariable => \$status,
  -font => 'Times 30', -fg => 'navy',
  -height => 3, -width => 20,
  )->pack;

my $button = $mw->Button(-text => "step one", -command => \&fun,
  -font => 'Times 30',
  )->pack;

MainLoop;

sub fun
  {
  $button->configure(-text => "step two" );
  Tk::IO->new(
    -linecommand => sub {$status = shift()=~tr/\n//dr},
    -childcommand => sub {
      $button->configure(-text => "step three" );
      },
    )->exec("echo start sleep; sleep 2; echo sleep ended");
  }

    [download]
[reply]
[d/l]
Re: how to fork & join in tk?
by zentara (Cardinal) on Apr 23, 2017 at 15:07 UTC
    Hi, "fork and join" are sort of 2 contradictory terms. Join is commonly used with threads, which on Windows emulates a Perl fork. Forks don't join, they exit with a return code. You don't say if you are on Windows or a Linux based system. You also don't say what exactly your forked subroutines will be doing, how will they signal that they are done? If you are on Windows and running long subroutines in an asynchronous matter, you may want to use threads. Threads with Tk need very special care, but can be done. Here are a couple of options, unless you want to provide more specifics as to what you are doing.

    Using Tk::ExecuteCommand, you can change the text of the ExecuteCommand module's default buttons to anything you want. 

    #!/usr/bin/perl -w
use Tk;
use Tk::ExecuteCommand;
use Tk::widgets qw/LabEntry/;
use strict;

my $mw = MainWindow->new;

my $ec = $mw->ExecuteCommand(
    -command    => '',
    -entryWidth => 50,
    -height     => 10,
    -label      => '',
    -text       => 'Execute',
                  )->pack;
$ec->configure(-command => 'date; sleep 10; date');


my $button = $mw->Button(-text =>'Do_it',
                         -background =>'hotpink',
                         -command => sub{ $ec->execute_command },
                        )->pack;
 
MainLoop;

    [download]

    Or you may want to try a thread with a shared variable, you can pass strings to be eval'd in the thread $data_in. I just used numbers in the simple hack. 

    #!/usr/bin/perl
use warnings;
use strict;
use threads;
use threads::shared;

# declare, share then assign

my $data_in:shared = 0;
my $data_ret:shared = '----';
my $button_control:shared = 0;
my $go_control:shared = 0;
my $die_control:shared = 0;

#create thread before any tk code is called
my $thr = threads->create( \&worker );

use Tk;
my $mw = MainWindow->new();
my $val = '----';

    my $label = $mw->Label(
         -width => 50,
         -textvariable => \$val )->pack();
 
    my $button = $mw->Button( -text => 'Start',
                              -command => \&start )->pack();
 
# you need a timer to read the shared var in thread
   my $timer = $mw->repeat(10 , sub{
                  $val = $data_ret;
                });

   my $timer1 = $mw->repeat(10, sub{  if($button_control){
                                         $button ->configure(-text=> "
+Next");
                                         $button_control = 0;
                                         }            
                                   });
                                     
MainLoop;

sub start{
  $button ->configure(-text=> "----");
  $go_control = 1;
  $data_in = int rand(20);  # pass some new data in
}


# no Tk code in thread
sub worker {
   my $count;
    while(1){
      
      if($die_control){
             print "thread finishing\n"; 
             return} 
      
      #wait for $go_control  
      if($go_control){      
          
                 if($die_control){
                    print "thread finishing\n"; 
                           return} 
               
               print "incoming $data_in\n";
               
               $count++;            
               print $count,"\n";
           if($count >= $data_in){ $go_control = 0; $data_ret = $count
+; $button_control = 1;}
           $data_ret = $count;
           select(undef,undef,undef,.25);
         
      
        }else{ 
         $count = 0;
         select(undef,undef,undef,.25); }# sleep until awakened 
   }
    
  return;
}

    [download]
    I'm not really a human, but I play one on earth. ..... an animated JAPH
[reply]
[d/l]
[select]

      When Perl lacks threads support, just minor changes for the 2nd demonstration and voila.

      use threads;
use threads::shared;
...
my $data_in:shared = 0;
my $data_ret:shared = '----';
my $button_control:shared = 0;
my $go_control:shared = 0;
my $die_control:shared = 0;
...
my $thr = threads->create( \&worker );
...

      [download]

      To this...

      use MCE::Hobo;
use MCE::Shared;
...
tie my $data_in, 'MCE::Shared', 0;
tie my $data_ret, 'MCE::Shared', '----';
tie my $button_control, 'MCE::Shared', 0;
tie my $go_control, 'MCE::Shared', 0;
tie my $die_control, 'MCE::Shared', 0;
...
my $thr = MCE::Hobo->create( \&worker );
...

      [download]

      Script with changes applied.

      Read more... (2 kB)

[reply]
[d/l]
[select]
        Hi marioroy, the usefulness of your MCE module is starting to become apparent to me. I have one question. The code you gave for use on a non-threaded perl uses 'MCE::Shared' instead of threads:shared. How do you share the data in MCE::Shared between the sub-processes? Is it through a shared file descriptor?
        I'm not really a human, but I play one on earth. ..... an animated JAPH
[reply]
Re: how to fork & join in tk?
by marioroy (Prior) on Apr 23, 2017 at 02:32 UTC

    Hello redss,

    Forking and joining may cause the app to crash on some platforms. A way around this is to spawn a worker or pool of workers in the background and send messages via a queue. Below please find two demonstrations, one using threads, the other MCE::Hobo. A shared scalar is constructed for updating the message string. A Tk timer is configured to run at 1/10th interval (fraction of a second).

    These examples are based on zentura++'s many examples where I've been validating the upcoming MCE 1.828 and MCE::Shared 1.825 releases alongside Tk, Gtk2, Gtk3, Wx, and what not, including Curses::UI.

    First, a threads demonstration.

    Read more... (2 kB)

    Likewise, a MCE::Hobo demonstration. This does a fork.

    Read more... (2 kB)

    Thank you Discipulus for introducing zentara recently. Zentara, am pleased to meet you. I've used a couple examples of yours for validating signal handling improvements in MCE 1.828 and MCE::Shared 1.825. I will post what and how after release day, possibly here. But that thread frightens me for some reason. Imho, folks may use any parallel module of their liking or do things by hand if that feels more natural.

    Well redss, am not sure if this will work for you. It may be helpful to do a search at the monastery for more Tk demonstrations. I wonder what other folks do myself. For more MCE::Hobo demonstrations, see also this thread by karlgoethebier.

    Regards, Mario

    This thread is helpful for updating a Tk label. This is where I've learn to update a Tk widget with ->configure.

    Found an old post by zentara: Re: Perl Tk and Threads.

[reply]
[d/l]
[select]

      If running on a Unix platform, you're in luck. One can spawn a Hobo process while Tk is running.

      For this demonstration, it's best to disable the button prior to spawning to prevent running two or more Hobos. The text is updated just like before with "Step One", "Step Two", etc. Finally, the button state is set back to normal after the Hobo completes processing.

      The hobo variable is either defined or not defined. Thus, state-like in itself.

      use strict;
use warnings;

use Tk;
use MCE::Hobo;
use MCE::Shared;

my $msg = MCE::Shared->scalar("Step One");
my $hobo;

my $mw = MainWindow->new();

$mw->protocol( WM_DELETE_WINDOW => \&quit );
$mw->geometry("+150+100");

$mw->Label( -text => "Tk + MCE::Hobo Demo", -height => 2, -width => 22
+ )->pack;

my $btn1 = $mw->Button( -text => "Start", -command => \&fun, -width =>
+ 10 );
   $btn1->pack;

my $btn2 = $mw->Button( -text => "Quit", -command => \&quit, -width =>
+ 10 );
   $btn2->pack;

my $timer = $mw->repeat( 100, sub {
   return unless $hobo;

   my $text = $msg->get;
   $btn1->configure( -text => $text );

   if ( $hobo->is_joinable ) {
      $hobo->join;
      if ( my $err = $hobo->error ) {
         print {*STDERR} "something went wrong: $err\n";
      }
      $btn1->configure( -state => "normal" );
      $hobo = undef;
   }
});

MainLoop();

sub fun {
   # important, disable button and reset the shared variable

   $btn1->configure( -state => "disabled" );
   $msg->set("Step One");

   $hobo = MCE::Hobo->create( sub {
      sleep 1;
      $msg->set("Step Two");
      sleep 1;
      $msg->set("Step Three");
   });

   return;
}

sub quit {
   $timer->cancel;
   $hobo->exit->join if $hobo;

   exit;
}

      [download]

      Q. Why does this work using MCE::Hobo?

      A. Hobos exit by calling CORE::kill("KILL", $$) when Tk is present to bypass any destructors during exiting.

      Regards, Mario

[reply]
[d/l]

Back to Seekers of Perl Wisdom