in reply to Re: Thread problems
in thread Thread problems

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

Replies are listed 'Best First'.
Re^3: Thread problems
by zentara (Cardinal) on Dec 04, 2009 at 18:29 UTC
    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]

      Hi,

      I like the following solution of my problem, although it contains some gotos. But the states in the thread make clear what the expected behaviour should be. It has handshakes and now the code is working exactly as I want.

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

use enum qw(:THREAD_CMD_ NONE WAIT WORK DIE);
use enum qw(:THREAD_STATE_ WAIT WORK);

my %thread_data:shared;
$thread_data{'state'} = THREAD_STATE_WAIT;
$thread_data{'cmd'} = THREAD_CMD_NONE;
$thread_data{'nb'} = 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
                              {
                                  $thread_data{'cmd'} = THREAD_CMD_WAI
+T;
                                  while( $thread_data{'state'} != THRE
+AD_STATE_WAIT )
                                  {
                                      select(undef, undef, undef, 0.1)
+;
                                  }
                              })->pack();

my $button_start = $mw->Button(-text => '(Re)Start thread',
                               -command =>
                               sub
                               {
                                   $thread_data{'cmd'} = THREAD_CMD_WO
+RK;
                                   while( $thread_data{'state'} != THR
+EAD_STATE_WORK )
                                   {
                                       select(undef, undef, undef, 0.1
+);
                                   }
                               })->pack();

my $entry = $mw->Entry(-textvariable => \$thread_data{'nb'}, -width =>
+ 10)->pack();


MainLoop;

sub clean_exit
{
    my @running_threads = threads->list;
    if (scalar(@running_threads) > 1)
    {
        print "ERROR: Too many threads are active. There should be onl
+y one thread!\n";
    }
    elsif (scalar(@running_threads) == 1)
    {
        $thread_data{'cmd'} = THREAD_CMD_DIE;
        $thr->join;
        exit;
    }
    else
    {
        print "ERROR: There should be at least one thread started!\n";
    }
}

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

  THREAD_STATE_WAIT:
    $thread_data{'state'} = THREAD_STATE_WAIT;

    while(1)
    {
        if( $thread_data{'cmd'} == THREAD_CMD_WORK )
        {
            $thread_data{'cmd'} = THREAD_CMD_NONE;
            goto THREAD_STATE_WORK;
        }
        elsif( $thread_data{'cmd'} == THREAD_CMD_DIE )
        {
            $thread_data{'cmd'} = THREAD_CMD_NONE;
            return;
        }
        elsif( $thread_data{'cmd'} == THREAD_CMD_WAIT )
        {
            $thread_data{'cmd'} = THREAD_CMD_NONE;
            goto THREAD_STATE_WAIT;
        }
        else
        {
            # wait
            select(undef,undef,undef,0.1);
        }
    }

  THREAD_STATE_WORK:
    $thread_data{'state'} = THREAD_STATE_WORK;
    print "\n";

    $i = $thread_data{'nb'};
    while(1)
    {
        if( $thread_data{'cmd'} == THREAD_CMD_WORK )
        {
            $thread_data{'cmd'} = THREAD_CMD_NONE;
            goto THREAD_STATE_WORK;
        }
        elsif( $thread_data{'cmd'} == THREAD_CMD_DIE )
        {
            $thread_data{'cmd'} = THREAD_CMD_NONE;
            return;
        }
        elsif( $thread_data{'cmd'} == THREAD_CMD_WAIT )
        {
            $thread_data{'cmd'} = THREAD_CMD_NONE;
            goto THREAD_STATE_WAIT;
        }
        else
        {
            # work
            print $i . " ";
            select(undef,undef,undef,0.5);
            $i++;
        }
    }
}

      [download]

      Greetings

      Dirk

[reply]
[d/l]
        use enum qw(:THREAD_CMD_ NONE WAIT WORK DIE);
use enum qw(:THREAD_STATE_ WAIT WORK);

        [download]
        .... where do those come from?...... i don't see any mention in the perldoc or google
        I'm not really a human, but I play one on earth.
        Old Perl Programmer Haiku
[reply]
[d/l]

In Section Seekers of Perl Wisdom