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

Hi,

I have a GUI with one button. When the user is pressing on this button, numbers are printed to the console. They start with 0 and are then increasing (0,1,2,3,4,5,...). The function which is printing the numbers to the console is running in another thread, so that the user is still able to use the GUI.

When the user is pressing again on the button, the old thread shall be stopped. And a new thread shall be started printing numbers.

I tried to implement this with the following code.

#!/usr/bin/perl

use strict;
use warnings;

use Tk;

use threads;
use threads::shared;

my $mw = new MainWindow;

my $button = $mw->Button('-relief' => 'raised',
                         '-text' => 'CreateNumbers',
                         '-command' => sub
                         {
                             &createNumberThread(0);
                         });

$button->pack();

MainLoop();


BEGIN
{
    my $nb_thread = undef;
    my $run :shared = 1;
    
    sub createNumberThread
    {
        my $nb = $_[0];
        

        # delete currently active thread if one is available
        if( defined $nb_thread )
        {
            $run = 0;
        }
        
        $nb_thread = threads->new(\&createNumbers, $nb);
        $nb_thread->detach();
        $run = 1;

        sub createNumbers
        {
            my $nb = $_[0];

            while($run)
            {
                print $nb . "\n";
                $nb++;
            }    
        }
    }
}

[download]

But it does not seem to work well. Because when I press several times on the button, I get the following error message back. 

Attempt to free non-existent shared string '_XEvent_', Perl interprete
+r: 0x1ca69ac at c:/Perl/site/lib/Tk/Widget.pm line 98 during global d
+estruction.
Free to wrong pool 1ca6060 not 246f88 at c:/Perl/site/lib/Tk/Widget.pm
+ line 98 during global destruction.

[download]

Any hints and help is welcome.

Thank you

Dirk

Replies are listed 'Best First'.
Re: Thread problems
by Khen1950fx (Canon) on Dec 02, 2009 at 22:51 UTC
[reply]
Re: Thread problems
by zentara (Cardinal) on Dec 03, 2009 at 17:43 UTC
    ...hi....if you want to do more advanced GUI stuff, using threads, consider switching to Perl/Gtk2...... it allows you to access widgets from the threads with the GLib::Idle->Add method...... plus it has a few other thread safety features.... google for examples
    I'm not really a human, but I play one on earth.
    Old Perl Programmer Haiku
[reply]

      Hi,

      Thank you for the hint with the example of zentara. And thank you for the advice to use Gtk.

      I like Tk very much and yesterday arrived the book "Mastering Perl/Tk". So I'd like to stay with Tk at the moment. I nearly finished an application with Tk now and I only need this small thread thing to complete.

      Now I could create a solution. Here is the code what is doing what I want.

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

my $work:shared = 0;
my $die:shared = 0;

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

use Tk;

my $mw = MainWindow->new();
$mw->protocol('WM_DELETE_WINDOW' => sub { &clean_exit }); 

my $button_stop = $mw->Button(-text => 'Stop thread',
                              -command =>
                              sub
                              {                          
                                  $work = 0;
                              })->pack();

my $button_start = $mw->Button(-text => '(Re)Start thread',
                               -command =>
                               sub
                               {
                                   $work = 0;
                                   sleep(1);
                                   $work = 1;
                               })->pack();

MainLoop;

sub clean_exit
{
    my @running_threads = threads->list;
    if (scalar(@running_threads) > 1)
    {
        print "ERROR: Too many threads are active. This was not planne
+d!\n";
    }
    elsif (scalar(@running_threads) == 1)
    {
        $work = 0;
        $die = 1;
        $thr->join;
        exit;
    }
    else
    {
        print "ERROR: There should be at least one thread started!\n";
    }
}

# no Tk code in thread
sub worker
{
    my $i;

  THREAD_START:    
    while($work == 0)
    {
        # just wait
        if( $die == 1 )
        {
            return;
        }            
    }

    $i = 0;
    while($work == 1)
    {
        print $i . "\n";        
        $i++;
    }

    if( $die == 0 )
    {
        goto THREAD_START;
    }
}

      [download]

      Hopefully you monks can tell me how to improve this code. Using goto is bad and waiting for an event in a loop is also not the best style and costs a lot of performance. But I don't know how to solve it in a different way.

      Greetings

      Dirk

[reply]
[d/l]
        Hopefully you monks can tell me how to improve this code.

        ... see TGI's reply in Reusable threads demo ..... he gives a little tutorial on how to fix the goto's and make sweeter code...... me.....it's Friday afternoon man.. !! ;-)

        I'm not really a human, but I play one on earth.
        Old Perl Programmer Haiku
[reply]

Back to Seekers of Perl Wisdom