Re: how to fork & join in tk?

[zentara]

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;

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;
}

[marioroy]

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 );
...

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 );
...

Script with changes applied.

Read more... (2 kB)

[zentara]

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?

[marioroy]

Hi zentara.

The sharing aspect is done through shared socket handles constructed using socketpair.

MCE::Shared::Server spawns a manager process. On the Windows platform or when threads is present; e.g. use threads, a thread is spawned instead. The data is managed by the shared-manager where it resides. MCE::Shared::Server is a two-part module. Shared objects are MCE::Shared::Object, the client facing package containing AUTOLOAD.

A shared object is a blessed array reference containing ID and CLASS_NAME. To see the actual data, one must call export.

use strict;
use warnings;
use feature 'say';

use MCE::Shared;
use Data::Dumper;

# first time, spawns the MCE::Shared::Server manager

my $va1 = MCE::Shared->scalar('foo');
my $ar1 = MCE::Shared->array('a'..'c');
my $ha1 = MCE::Shared->hash('foo' => 'bar');

say Dumper $ha1;
say Dumper $ha1->export;

# construction via the TIE interface

my $va2 = tie my $va, 'MCE::Shared', 'foo';
my $ar2 = tie my @ar, 'MCE::Shared', 'a'..'c';
my $ha2 = tie my %ha, 'MCE::Shared', 'foo' => 'bar';

say Dumper $ha2;
say Dumper $ha2->export; # or Dumper tied(%ha)->export;

__END__

$VAR1 = bless( [
                 3,
                 'MCE::Shared::Hash'
               ], 'MCE::Shared::Object' );

$VAR1 = bless( {
                 'foo' => 'bar'
               }, 'MCE::Shared::Hash' );

$VAR1 = bless( [
                 6,
                 'MCE::Shared::Hash'
               ], 'MCE::Shared::Object' );

$VAR1 = bless( {
                 'foo' => 'bar'
               }, 'MCE::Shared::Hash' );

The upcoming 1.825 release can return an unblessed array or hash for later converting to JSON. From receiving the idea from 1nickt. Thank you.

say Dumper $ha2->export({ unbless => 1 });

$VAR1 = {
          'foo' => 'bar'
        };