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

I want to make such kind of GUI application: click an button to start some long-time work, click another button to stop it. It is likely to be threaded. Something like this one: 

use strict;
use threads;
use threads::shared;

# actually, maybe Gtk2.
# I'm still not acquainted with Gtk2, so use Tk as example
use Tk;

my $flag : shared;
my $dm = threads->new(\&daemon);

my $mw = Tk::MainWindow->new();

my $but_start = $mw->Button(
  -text    => 'start',
  -command => sub{
    lock $flag;
    cond_signal $flag;
  }
)->pack;

my $but_stop = $mw->Button(
  -text    => 'stop',
  -command => sub{}
)->pack;

#########################################
# the main background thread
#########################################
sub daemon {
  while (1) {
    {
      lock $flag;
      cond_wait $flag;
    }
    
    # do work while active
    my $worker = threads->new(\&work);
    $worker->join();
  }
}

#########################################
# a worker thread that acutally do things
#########################################
sub work {
  system "strange long time work";
}

[download]

So, is there any way to kill the worker, or to kill the actually running process?

Replies are listed 'Best First'.
Re: how to stop an running task?
by zentara (Cardinal) on Nov 13, 2009 at 12:59 UTC
    So, is there any way to kill the worker, or to kill the actually running process?

    yes...to kill the worker thread, the thread must return, or reach the end of it's code block.

    to kill the spawned process, you need to get it's pid, either by searching the pid list (from :ProcProcess::Table, or top.... or you can use a better form of ipc, rather than using system... read perldoc perlipc, or search nodes here for piped-opens

    ...here is an example with top 

    #!/usr/bin/perl
use warnings;
use strict;

my $pid = $$;

#my $pid0 = open(FH, "long strange work" |) or die "$\n";
my $pid1 = open(TH,"top -d 0 -b -p $pid |");

while(1){
  my @words = split(/\s+/,<TH>);
  $words[0] ||= 0;
 if($words[0] eq $pid){ print "$words[4] $words[9]  \n"}
}

    [download]
    .... now there are things to consider, depending on what "long strange work " really is. Like you may need to kill the pid you get plus all its children pids( usually the case) Like Killing children's of children

    ...to get to your gui code, it would go like this..... i have a clunky goto END in the thread, to force the thread to end, but you could use a simple return 

    #!/usr/bin/perl
use warnings;
use strict;
use threads;
use threads::shared;
use Glib qw/TRUE FALSE/;
use Gtk2 '-init';

my $data = shift || 0;  

my %shash;
#share(%shash); #will work only for first level keys
my %thash;
my %workers;
my $numworkers = 3;
my %pbar;

foreach my $dthread(1..$numworkers){
  share ($shash{$dthread}{'go'});
  share ($shash{$dthread}{'data'});
  share ($shash{$dthread}{'die'});
 
  $shash{$dthread}{'go'} = 0;
  $shash{$dthread}{'data'} = $data;
  $shash{$dthread}{'die'} = 0;
 
  $thash{$dthread}{'thread'} = threads->new(\&work,$dthread);
  $thash{$dthread}{'button'} = undef;    #thread start/stop button
  $thash{$dthread}{'lconnect'} = undef;  #used in signal blocking
  $thash{$dthread}{'sconnect'} = undef;  #used in signal blocking
}

#set the desired style
set_style();

my $window = Gtk2::Window->new('toplevel');
$window->set_title('Z Multi-threads-w-ProgressBars');
$window ->signal_connect( 'destroy' => \&exit_thr );
$window->set_border_width(10);
$window->set_size_request(400,400);

my $vbox = Gtk2::VBox->new( FALSE, 6 );
$window->add($vbox);
$vbox->set_border_width(2);

my $hbox= Gtk2::HBox->new( FALSE, 6 );
my $hbox1 = Gtk2::HBox->new( FALSE, 6 );
$vbox->pack_end($hbox,FALSE,FALSE,0);
$vbox->pack_end (Gtk2::HSeparator->new, FALSE, FALSE, 0);
$vbox->pack_end($hbox1,FALSE,FALSE,0);
$hbox->set_border_width(2);
$vbox->pack_end (Gtk2::HSeparator->new, FALSE, FALSE, 0);

my $ebutton = Gtk2::Button->new_from_stock('gtk-quit');
$hbox->pack_end( $ebutton, FALSE, FALSE, 0 );
$ebutton->signal_connect( clicked => \&exit_thr );

foreach my $dthread(1..$numworkers){
 $pbar{$dthread}{'bar'} = Gtk2::ProgressBar->new();
 $pbar{$dthread}{'bar'}->set_text('T'.$dthread.'->');
 $hbox->pack_start($pbar{$dthread}{'bar'},1,1,0);
}
######################################################
#make buttons
foreach my $dthread(1..$numworkers){
 $thash{$dthread}{'button'} = Gtk2::Button->new_with_label('Run T'.$dt
+hread);
 $hbox1->pack_start($thash{$dthread}{'button'} , 1, 1, 0 );
 $thash{$dthread}{'lconnect'} = $thash{$dthread}{'button'}
                        ->signal_connect( clicked => sub{ launch($dthr
+ead) });
}

#make text display area###################################
# Create a textbuffer to contain that string 
my $textbuffer = Gtk2::TextBuffer->new();
$textbuffer->set_text("Thread Output\n");

# Create a textview using that textbuffer 
my $textview = Gtk2::TextView->new_with_buffer($textbuffer);

# Add the textview to a scrolledwindow 
my $scrolledwindow = Gtk2::ScrolledWindow->new( undef, undef );
$scrolledwindow->add($textview);
$vbox->pack_start($scrolledwindow, 1, 1, 0 );

my $end_mark = $textbuffer->create_mark( 'end', $textbuffer->get_end_i
+ter, FALSE );
# every time we insert text, scroll to that mark.
$textbuffer->signal_connect(
    insert_text => sub {
        $textview->scroll_to_mark( $end_mark, 0.0, TRUE, 0.0, 1.0 );
    }
);


$window->show_all();

foreach my $dthread(1..$numworkers){
$pbar{$dthread}{'bar'}->hide;   #needs to be called after show_all
}

Gtk2->main;

#####################################
sub delete_event {
Gtk2->main_quit;
return FALSE;
}
#######################################
sub launch{
   my $dthread = shift;
   $pbar{$dthread}{'bar'}->show;
   $thash{$dthread}{'button'}->set_label('Stop T'.$dthread);
   $thash{$dthread}{'button'}->signal_handler_block( $thash{$dthread}{
+'lconnect'} );
   $thash{$dthread}{'sconnect'} =
     $thash{$dthread}{'button'}->signal_connect( clicked => sub{ stop(
+ $dthread ) });
   $shash{$dthread}{'go'} = 1;
  
   Glib::Timeout->add (100, 
         sub { 
            if($shash{$dthread}{'go'} == 1){
         my $spacer = "\t\t" x ($dthread-1).$dthread.'->';
#         my $spacer = "\t" x $dthread;
                 $pbar{$dthread}{'bar'}->
            set_text('Thread'.$dthread.'->'.$shash{$dthread}{'data'});
         $pbar{$dthread}{'bar'}->
            set_fraction($shash{$dthread}{'data'}/100);
                 $textbuffer->insert( 
                 $textbuffer->get_end_iter, "$spacer $shash{$dthread}{
+'data'}\n" );
                 if( $shash{$dthread}{'data'} == 100 ){ stop($dthread)
+; return FALSE; } 
             return TRUE;
               }else{ 
            return FALSE;
              }
        
      }
        );
}
##################################################
sub stop{
   my $dthread = shift;
   $pbar{$dthread}{'bar'}->hide;
   $shash{$dthread}{'go'} = 0;
   $shash{$dthread}{'data'} = 0;
   $thash{$dthread}{'button'}->set_label('Run T'.$dthread);
   $thash{$dthread}{'button'}->
         signal_handler_block ($thash{$dthread}{'sconnect'});
   $thash{$dthread}{'button'}->
         signal_handler_unblock ($thash{$dthread}{'lconnect'});
}
#########################################################
sub work{
    my $dthread = shift;
    $|++; 
    while(1){
       if($shash{$dthread}{'die'} == 1){ goto END }; 
      
       if ( $shash{$dthread}{'go'} == 1 ){

         foreach my $num (1..100){
            $shash{$dthread}{'data'} = $num; 
            select(undef,undef,undef, .3);
            if($shash{$dthread}{'go'} == 0){last}
            if($shash{$dthread}{'die'} == 1){ goto END }; 
           }
       
           $shash{$dthread}{'go'} = 0; #turn off self before returning
+      
       }else
         { sleep 1 }
    }
END:
}
#######################################################
sub exit_thr{
  
foreach my $dthread(1..$numworkers){
  $shash{$dthread}{'die'} = 1;
  $thash{$dthread}{'thread'}->join; 
}  

  Gtk2->main_quit;
  return FALSE;
}
###########################################
sub set_style{
Gtk2::Rc->parse_string(<<__);

style "normal" {
font_name ="serif 12"
}

style "my_text" {
font_name ="sans 24"
text[NORMAL] = "#FFAA00"
base[NORMAL] = "#000000"   
GtkTextView::cursor-color = "red"
}

widget "*" style "normal"
widget "*Text*" style "my_text"
__
}
#################################################

    [download]
    I'm not really a human, but I play one on earth.
    Old Perl Programmer Haiku
[reply]
[d/l]
[select]
Re: how to stop an running task?
by BioLion (Curate) on Nov 13, 2009 at 12:01 UTC

    Maybe a little rethink about how you implement the threads and switch to Parallel::Forker? I talked about it before ( here ), and it sounds like you need a similar upgrade in your thread control as OP did there.

    Alternately, if you keep track of the pid, you can manually kill it, but i am not sure how safe / easy that would be (and it depends on you OS etc...). See kill and try super searching.

    Update Added second paragraph.

    Just a something something...
[reply]

Back to Seekers of Perl Wisdom