controlling threads with Tk: while loop vs. signals

A few people have asked recently about how to deal with the problem that threads must be started early in Tk programs, and are often running before the Tk gui gets going. Here are 2 methods. One uses a while loop and shared variables, the other Thread::Semaphore and signals.

The while loop one runs well, but it has the drawback of needing to frequently check the status of shared variables. The signals method will break a while loop running, but has the drawback of letting the thread run a bit, until the signal handlers get setup. If you can see a way to prevent the Signals thread from printing 1 or 2 lines before responding to the suspend request, please show us how.

The code is pretty much self documenting, and I purposely left the variables simple and straight forward to avoid obscurring what is happening.

#!/usr/bin/perl
use warnings;
use strict;
use threads 'exit' => 'threads_only';
use threads::shared;
use IO::Pipe;
use Thread::Semaphore;

# uses a reusable thread concept
# shows 2 ways to control the thread
#  1 -- thru a while loop
#  2 -- thru signals, suspend resume
 
#create threads before any tk code is called
my $go_control:shared = 0;  # controls for while loop method
my $die_control:shared = 0;

# create pipes and threads
my $pipe1 = IO::Pipe->new();
my $thr1 = threads->new(\&execute1, $pipe1);


# Create a semaphore for signaling  and pass it to thread 2
my $sema = Thread::Semaphore->new();
my $pipe2 = IO::Pipe->new();
my $thr2 = threads->new(\&execute2, $pipe2, $sema );

 
# after thread initiation is complete, get Tk going
use Tk;

my $mw = MainWindow->new();
$mw->geometry('800x500');

# catch window close button to clean up threads
$mw->protocol('WM_DELETE_WINDOW' => sub { &clean_exit }); 

$mw->fontCreate('big',-weight=>'bold', -size=> 14 );

# setup pipes for Tk's fileevent 
$pipe1->reader(); # make Tk's end a reader
$pipe2->reader();

# add fileevents( similar to select) on pipes
$mw->fileevent($pipe1 ,'readable', \&write_t1);
$mw->fileevent($pipe2 ,'readable', \&write_t2);

# control button frame
my $topframe = $mw->Frame(-bg => 'brown')->pack(-fill=>'x', -expand=> 
+0);

my $control1 = $topframe->Button(-text => 'Start 1',
               -font => 'big',
               -bg => 'lightyellow',
               -command => \&start1
              )->pack(-side =>'left',-padx=>20);

my $lab1 = $topframe->Label(-text => 'while loop control',
               -font => 'big',
               -bg => 'lightyellow',
              )->pack(-side =>'left',-padx=>20);


my $control2 = $topframe->Button(-text => 'Start 2',
               -font => 'big',
               -bg => 'black',
               -fg => 'lightyellow',
               -command => \&start2
              )->pack(-side =>'right', -padx=>20);

my $lab2 = $topframe->Label(-text => 'signal control',
               -font => 'big',
               -bg => 'black',
               -fg => 'lightyellow',
              )->pack(-side =>'right',-padx=>20);



# make a frame to lock in the scrolled text
my $frame = $mw->Frame()->pack(-fill=>'both', -expand=> 1);

 
my $text1 = $frame->Scrolled('Text',
                 -background=>'white',
         -foreground=>'black',
                 -font => 'big',
                 -height => 550, # how many lines are shown
                 -width => 20, # how many characters per line
                 )->pack(-side=>'left', -fill=>'both', -expand=>1);

$text1-> insert('end', "Thread 1 output\n"); 

my $text2 = $frame->Scrolled('Text',
                 -background=>'black',
         -foreground=>'white',
                 -font => 'big',
                 -height => 550, # how many lines are shown
                 -width => 20, # how many characters per line
                 )->pack(-side=>'right',-fill=>'both', -expand=>1);

$text2-> insert('end', "Thread 2 output\n");

# this is delayed, and I don't know a workaround
# so it prints once before suspending
# suspend thread 2
$sema->down();
$thr2->kill('STOP');

MainLoop;


sub clean_exit{

     # harvest thread 1
     $die_control = 1;
     $thr1->join;
     print " thread1 joined\n";
   
     # harvest thread 2
     # a problem exists in that you need to detect
     # if the $sema is down or up, to see if thread 2 is running or su
+spended 
     # when you want to exit
     # The "down_nb" method attempts to decrease the semaphore's count
+ 
     # by the specified number (which must be an integer >= 1), or
     # by one if no number is specified.
     # If the semaphore's count would drop below zero, this method wil
+l return false, 
     # and the semaphore's count remains unchanged.
     # Otherwise, the semaphore's count is decremented and this method
+ returns true.

     # turn on suspended thread if needed .. a bit tricky logic wise
     if(! $sema->down_nb() ){ $sema->up(); print " sema up\n"; }
                   
     $thr2->kill('KILL');
     $thr2->join;
     print " thread2 joined\n";
  
     exit;
}

sub start1{
   my $text = $control1->cget(-text);
   if ($text eq 'Start 1'){
          $go_control = 1;
          $control1->configure(-text=>'Stop  1');
          }else{
          $go_control = 0;
          $control1->configure(-text=>'Start 1');
          } 

}

sub write_t1{

  my $buf = <$pipe1>;
  $text1->insert('end',"$buf");
  $text1->see('end');
}



sub execute1{
 # thread code      
  
  my $pipe = shift;
  my $wh = $pipe->writer();
  $wh->autoflush(1);

   while(1){
      
      if($die_control){ return }; 
      
      #wait for $go_control  
      if($go_control){      
               
               print $wh time." continuing\n";
               
                 if($die_control){ return }; 
               
               #do your stuff here             
               
               while(1){
                        if($die_control){ return }; 
                        last if ! $go_control;
                        print "1";
                        print $wh  time."\n";
                        select(undef,undef,undef,.5); # sleep until aw
+akened for next command 
                      }
                    
               #done, so turn thread back to sleep
               print $wh time." suspending\n";             
           $go_control = 0;
        
        }else{ 

       select(undef,undef,undef,.25); # sleep until awakened for next 
+command 
    }
  } 
return;
}

sub start2{
   my $text = $control2->cget(-text);
   if ($text eq 'Start 2'){
          
           $sema->up();
           $thr2->kill('CONT');
 
          $control2->configure(-text=>'Stop  2');
          }else{
           
           $sema->down();
           $thr2->kill('STOP');
           
           $control2->configure(-text=>'Start 2');
          } 

}

sub write_t2{

  my $buf = <$pipe2>;
  $text2->insert('end',"$buf");
  $text2->see('end');
}



sub execute2{

   my ($pipe,$sema) = @_;
   my $wh = $pipe->writer();
   $wh->autoflush(1);

   my $myobject = threads->self;
   my $mytid= $myobject->tid;

   #setup signal handlers
   $SIG{'KILL'} = sub { print "2 killed\n"; threads->exit; };

   # Thread 'suspend/resume' signal handler
   $SIG{'STOP'} = sub {
               print $wh time.' suspended'."\n";
               $sema->down();
             }; # Thread suspended
   
   
   $SIG{'CONT'} = sub {
              $sema->up();        # Thread resumes
              print $wh time.' continuing'."\n";
         };

   
   while(1){
         print "2";
         print $wh  time."\n";
         select(undef,undef,undef,.5); # sleep until awakened for next
+ command 
     }

}
[download]

I'm not really a human, but I play one on earth.
Old Perl Programmer Haiku ................... flash japh

Comment on controlling threads with Tk: while loop vs. signals Download Code

Replies are listed 'Best First'.
Re: controlling threads with Tk: while loop vs. signals by BrowserUk (Patriarch) on Feb 14, 2012 at 21:41 UTC
Pairing the clumsy Thread::Semaphore with the should-never-have-been-invented "threads signalling" is an extremely convoluted way of controlling a producer thread. This does what I think you were trying to achieve -- start the thread 'suspended' and allow it to be resumed and suspended -- with rather less fuss and complication: #! perl -slw use strict; use threads; use threads::shared; use Thread::Queue; use Tk; my $sem :shared = 0; sub thread { my( $Q, $file ) = @_; open my $fh, '<', $file or die $!; while( <$fh> ) { lock $sem; cond_wait( $sem ); $Q->enqueue( $_ ); } } my $Q = new Thread::Queue; my $t = async( \&thread, $Q, $ARGV[0] )->detach; my $mw = MainWindow->new; $mw->geometry( "1024x768" ); my $b1; $b1 = $mw->Label->pack( -anchor => 'nw' )->Button( -width => 10, -text => 'start', -command => sub{ if( $sem ) { $b1->configure( -text => 'resume' ); lock $sem; cond_signal( $sem ); $sem = 0; } else{ $b1->configure( -text => 'suspend' ); lock $sem; cond_signal( $sem ); $sem = 1; } } )->pack( -side => 'left' ); my $lb = $mw->Scrolled( 'Listbox', -height => 55, -scrollbars => 'e' )->pack( -anchor => 's', -fill => 'both' )->Subwidget('scrolled'); my $repeat = $mw->repeat( 1 => sub { while( $Q->pending ) { $lb->insert( 'end', $Q->dequeue ); $lb->see( 'end' ); $mw->update; lock $sem; $sem and cond_signal( $sem ); } }); $mw->MainLoop; [download] Update: Simplified the code a little. With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday' Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error. "Science is about questioning the status quo. Questioning authority". In the absence of evidence, opinion is indistinguishable from prejudice. The start of some sanity?	[reply] [d/l]

Replies are listed 'Best First'.

Re: controlling threads with Tk: while loop vs. signals
by BrowserUk (Patriarch) on Feb 14, 2012 at 21:41 UTC

Pairing the clumsy Thread::Semaphore with the should-never-have-been-invented "threads signalling" is an extremely convoluted way of controlling a producer thread.

This does what I think you were trying to achieve -- start the thread 'suspended' and allow it to be resumed and suspended -- with rather less fuss and complication:

#! perl -slw
use strict;
use threads;
use threads::shared;
use Thread::Queue;
use Tk;

my $sem :shared = 0;

sub thread {
    my( $Q, $file ) = @_;
    open my $fh, '<', $file or die $!;
    while( <$fh> ) {
        lock $sem; cond_wait( $sem );
        $Q->enqueue( $_ );
    }
}

my $Q = new Thread::Queue;
my $t = async( \&thread, $Q, $ARGV[0] )->detach;

my $mw = MainWindow->new;
   $mw->geometry( "1024x768" );

my $b1; $b1 = $mw->Label->pack( -anchor => 'nw' )->Button(
    -width => 10,
    -text => 'start',  -command => sub{
        if( $sem ) {
            $b1->configure( -text => 'resume' );
            lock $sem; cond_signal( $sem ); $sem = 0;
        }
        else{
            $b1->configure( -text => 'suspend' );
            lock $sem; cond_signal( $sem ); $sem = 1;
        }
    }
)->pack( -side => 'left' );

my $lb = $mw->Scrolled(
    'Listbox', -height => 55, -scrollbars => 'e'
)->pack( -anchor => 's', -fill => 'both' )->Subwidget('scrolled');

my $repeat = $mw->repeat( 1 => sub {
    while( $Q->pending ) {
        $lb->insert( 'end', $Q->dequeue );
        $lb->see( 'end' );
        $mw->update;
        lock $sem; $sem and cond_signal( $sem );
    }
});

$mw->MainLoop;
[download]

Update: Simplified the code a little.

With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'

Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.

"Science is about questioning the status quo. Questioning authority".

In the absence of evidence, opinion is indistinguishable from prejudice.

The start of some sanity?

[reply]
[d/l]