Re: Updating GUI from a callback using threads

[zentara <zentara1 sbcglobal net>]

On Tue, 5 Aug 2008 13:54:45 +0200
"Tadej BorovÅak" <tadeboro gmail com> wrote:

> Hello,
>
> I need to develop quite simple GUI for a project at the University.
>
> The main task of this GUI is to present results of a search to an
> user. And since those searches (which are executed inside callbacks)
> can take a few minutes to finish, I would like to update my GUI during
> the search as an indication to a user, that program is working (and
> not just standing there).
>
> Below is a sample program that shows what I'm trying to achieve (when
> the program exits, it prints error message "GLib-GObject-CRITICAL **:
> g_object_unref: assertion `G_IS_OBJECT (object)' failed at test.pl
> line 37." for each widget).
>
> My problem is that I do not know how to use Gtk and threads in perl.
> Any suggestions, documentation links ... are appreciated.
>
> Thanks in advance.

Hi, threads (with GUI's) are tricky with Perl, mostly because when a thread gets created,
it gets a copy of the parent at the time of creation. So it becomes a problem
when you try to dynamically spawn threads from the gui, as you do with the thread
creation from a button press. If you notice, the error occurs on the second run,
and is probably because the second thread spawned is getting confused with the
copy of the first thread which it gets.

Additionally, you have reference cleanup problems with threads, which can cause
unwanted memory gains with each thread spawn, because object references in
joined threads are not completely cleaned up.

Now, it is possible to fine tune a program which dynamically spawns threads, but
an error may occur after 100 runs..... the Gtk2 examples have a dynamic thread
example that seems to work, but it is not easy to modify and keep working error free.

Finally, Gtk2 has a means of attempting to provide thread safety, meaning you can access
Gtk2 widgets from the thread. This can be very problemsome too. There is the thread->enter
and thread->leave mechanism, which you may see in various examples. However, the
preferred way to access Gtk2 widgets from a thread, is with Glib::Idle->add()

So here are some rules to follow that will let things work right. These can be violated,
but you may cause errors,  These rules, if followed, will give foolproof thread operation.

1. Create your thread BEFORE any GUI is invoked. This is done by making a sleeping
thread, and using your gui to wake it up with button presses or callbacks, and shared variables.
Also in Gtk2 programs, use Glib::Object->set_threadsafe (TRUE);
Perl/Tk ( not Perl/Gtk2 ) is very sensitive to this. No Tk code can get into a thread, Tk
is not thread safe. Gtk2 is much better than Tk however. :-)

 2. Reuse your threads to avoid memory gains. So create a set of sleeping threads at
the start of your program, and reuse them. If they contain objects, clear out the object
data and reuse the objects for the next thread wakeup run. 

3. Keep the creation of all gui widgets in the main thread. Don't try to create widgets
in the thread code block. Instead, use Glib::Idle->add() in threads to access the widgets.

4. Remember, a thread must return, or reach the end of it's code block, for it to be joined.
The latest threads.pm does have some signalling mechanism to terminate a thread, but
in earlier versions of threads, you must make it return, or you will have threads giving
harmless errors like "program terminated while 2 threads were still running".
Calling "exit" from a thread will kill all, including the parent.


For a non-gui reusable threads example, (just to show you how it works without a gui),
see  http://perlmonks.org?node_id=691785
You can also pass in code to a thread thru shared variables, and eval it in the thread.
So once a thread is created, reuse it, pass it new data or code to be evaled, and keep
it alive untill you exit the program.


So.........here is an example that incorporates everything I just said. It will run all day
with no memory gain or errors.  
I violate 1 rule, by making the thread after some GUI
code is written (so I could pass the labal and pbar), BUT I could have passed those
to the thread thru shared variables. You get away with what you can. :-)  In Perl/Tk,
I couldn't get away with that, but Gtk2's thread safety mechanism, lets it go. However,
If I tried to spawn the thread from a button press callback, I would get the same error
as your script, as the thread's copy-on-creation, would get the 2 threads confused.

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

Glib::Object->set_threadsafe (TRUE);

#setup shared hash
my %shash;
share(%shash); #will work for first level keys

$shash{'go'} = 0;
$shash{'work'} = '';   #in case I wanted to pass some data or code
$shash{'die'} = 0;

my $window = Gtk2::Window->new('toplevel');
$window ->signal_connect( 'destroy' => \&delete_event );
$window->set_border_width(10);
$window->set_size_request(300,300);

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 => \&delete_event );

my $pbar = Gtk2::ProgressBar->new();
$pbar->set_pulse_step(.1);
$hbox->pack_start($pbar,1,1,0);

my $count = 0;
my $label_w_markup = Gtk2::Label->new();
$label_w_markup->set_markup("<span foreground=\"yellow1\" 
  size=\"40000\">$count</span>");

$vbox->pack_end($label_w_markup,FALSE,FALSE,4); 

######################################################

my $tbutton = Gtk2::Button->new_with_label('Run Thread');
 $hbox1->pack_start($tbutton , 1, 1, 0 );
my $lconnect = $tbutton->signal_connect( clicked => sub{ launch() });
my $sconnect;

$window->show_all();
$pbar->hide;   #needs to be called after show_all

#create 1 sleeping thread passing it the label and pbar to control
my $thread = threads->new(\&work, $label_w_markup, $pbar);

Gtk2->main;
######################################
sub delete_event {
  $shash{'go'} = 0;
  $shash{'die'} = 1;
  $thread->join;
  Gtk2->main_quit;
  return FALSE;
}
#######################################
sub launch{
   $pbar->show;
   $tbutton->set_label('Stop Thread');
   $tbutton->signal_handler_block($lconnect);
   $sconnect = $tbutton->signal_connect( clicked => sub{ stop() });
   $shash{'go'} = 1;
}
##################################################
sub stop{
   print "stopped\n";
   $shash{'go'} = 0;
   $pbar->hide;
   $tbutton->set_label('Run Thread');
   $tbutton->signal_handler_block ($sconnect);
   $tbutton->signal_handler_unblock ($lconnect);
}
#########################################################
sub work{
    
    my ($label,$pbar) = @_;
    $|++; 
    while(1){
       if($shash{'die'} == 1){ return }; 
      
       if ( $shash{'go'} == 1 ){

         foreach my $num (1..1000){
                     
                 Glib::Idle->add(
                   sub{
                    if($shash{'die'} == 1){ return };
                    $label->set_markup("<span foreground=\"yellow1\" 
                    size=\"40000\">$num</span>");
                    $pbar->pulse;
                    return FALSE;
                   });
                
                select(undef,undef,undef, .1);

            if($shash{'go'} == 0){last}
            if($shash{'die'} == 1){ return }; 
           }
       
           $shash{'go'} = 0; #turn off self before returning      
       }else
         { select(undef,undef,undef,.1) } #sleep time
    }

return;
}
#####################################################################


Good luck,
zentara


-- 
I'm not really a human, but I play one on earth.
http://zentara.net/Remember_How_Lucky_You_Are.html