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

Dear Monks, the module threads on cpan.org contains an example "boss.pl" as shown below.
I understand the limit "$MAX_THREADS = 10;" to limit the maximum threads at the same time to 10.
But how to limit the maximum threads in this script. After 100 threads (or whatever) the script should stop.

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

use threads 1.39;
use threads::shared;
use Thread::Queue;

### Global Variables ###
# Maximum working threads
my $MAX_THREADS = 10;

# Maximum thread working time
my $TIMEOUT = 10;
# Flag to inform all threads that application is terminating
my $TERM :shared = 0;

# Prevents double detach attempts
my $DETACHING :shared;


### Signal Handling ###

# Gracefully terminate application on ^C
# or command line 'kill'
$SIG{'INT'} = $SIG{'TERM'} =
sub {
print(">>> Terminating <<<\n");
$TERM = 1;
};

# This signal handler is called inside threads
# that get cancelled by the timer thread
$SIG{'KILL'} =
sub {
# Tell user we've been terminated
printf(" %3d <- Killed\n",
threads->tid());
# Detach and terminate
lock($DETACHING);
threads->detach() if ! threads->is_detached();
threads->exit();
};


### Main Processing Section ###
MAIN:
{
# Start timer thread
my $queue = Thread::Queue->new();
threads->create('timer', $queue)->detach();

# Manage the thread pool until signalled to terminate
while (! $TERM) {
# Keep max threads running
for (my $needed = $MAX_THREADS - threads->list();
$needed && ! $TERM;
$needed--)
{
# New thread
threads->create('worker', $queue, $TIMEOUT);
}
# Wait for any threads to finish
sleep(1);
}
### CLEANING UP ###

# Wait for max timeout for threads to finish
while ((threads->list() > 0) && $TIMEOUT--) {
sleep(1);
}

# Detach and kill any remaining threads
foreach my $thr (threads->list()) {
lock($DETACHING);
$thr->detach() if ! $thr->is_detached();
$thr->kill('KILL');
}
}

print("Done\n");
exit(0);


### Thread Entry Point Subroutines ###

# A worker thread
sub worker
{
my ($queue, $timeout) = @_;

### INITIALIZE ###

# My thread ID
my $tid = threads->tid();
printf("Working -> %3d\n", $tid);

# Register with timer thread
$queue->enqueue($tid, $timeout);


### WORK ###

# Do some work while monitoring $TERM
my $sleep = 5 + int(rand(10));
while (($sleep > 0) && ! $TERM) {
$sleep -= sleep($sleep);
}


### DONE ###

# Remove signal handler
$SIG{'KILL'} = sub {};

# Unregister with timer thread
$queue->enqueue($tid, undef);

# Tell user we're done
printf(" %3d <- Finished\n", $tid);

# Detach and terminate
lock($DETACHING);
threads->detach() if ! threads->is_detached();
threads->exit();
}


# The timer thread that monitors other threads for timeout sub timer
{
my $queue = shift; # The registration queue
my %timers; # Contains threads and timeouts

# Loop until told to quit
while (! $TERM) {
# Check queue
while (my $tid = $queue->dequeue_nb()) {
if (! ($timers{$tid}{'timeout'} = $queue->dequeue()) || ! ($timers{$tid}{'thread'} = threads->object($tid))) {
# No timeout - unregister thread
delete($timers{$tid});
}
}

# Cancel timed out threads
foreach my $tid (keys(%timers)) {
if (--$timers{$tid}{'timeout'} < 0) {
$timers{$tid}{'thread'}->kill('KILL');
delete($timers{$tid});
}
}

# Tick tock
sleep(1);
}
}

__END__
  • Comment on how to limit maximum threads in cpan example boss.pl

Replies are listed 'Best First'.
Re: how to limit maximum threads in cpan example boss.pl
by jethro (Monsignor) on Aug 11, 2008 at 12:12 UTC

    Change the line to $MAX_THREADS = 100;!? As this answer is more than trivial, what are you really asking ? Could you rephrase your question?

    UPDATE: Got it. You want to know how to limit the total number of threads run in one session

    First of all, if you post something here on perlmonks, use <code> and </code> to enclose your code, it is really hard to read without indentation

    You might just change the thread creation loop to this:

    my $LIFETIME_THREADS=100; while (! $TERM) { for (my $needed = $MAX_THREADS - threads->list(); $needed && ! $TERM; $needed--) { # New thread threads->create('worker', $queue, $TIMEOUT) if ($LIFETIME_THREADS- +- >0); exit(0) if (threads->list()==0); } # Wait for any threads to finish sleep(1); }

    2ND UPDATE: As AnonMonk observed, the loop runs through even after $LIFETIME_THREADS reaches 0, so $LIFETIME_THREADS gets negative. Testing for 0 isn't enough here. Corrected now.

      I think you want
      if $LIFETIME_THREADS-- >0;
      because -1 is true :)
      C:\>perl -e die(666)if-1 666 at -e line 1. C:\>perl -e die(666)if-0 C:\>
        It's running perfectly now. I had only to add this line "$LIFETIME_THREADS-- >0;" also to the timeout section with the signal handler to be sure that the script will finish properly every time.

        Thanks for your help ...

        Franc
      i think he wants exit once 100 threads have finished (10 max at one time)