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

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

I found the enum package in CPAN: enum.pm.