thread_leak.pl

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

use threads;
my $minthreads = 5;
my $maxthreads = 50;
my $queue_size = 1001;
my @workers;
my @zombies;

maybe_add_worker() for 1..$minthreads;
for(;;)  {
    if ( $queue_size < 1000 ) {
        remove_worker();
    } elsif ( $queue_size > 1000 ) {
        maybe_add_worker();
    }
    zap_zombies();
}

sub maybe_add_worker {
    if ( @workers < $maxthreads ) {
        print "Creating new thread\n";
        push @workers, threads->new(\&do_work);
    } else {
        $queue_size = 0;
    }
}

sub remove_worker {
    if (@workers > $minthreads ) {
        print "Removing worker\n";
        my $thread = shift @workers;
        $thread->kill('STOP');
        push @zombies, $thread;
    } else {
        $queue_size = 1001;
    }
}

sub zap_zombies {
    foreach my $thread (@zombies) {
        if ($thread->is_joinable()) {
            my $tid = $thread->tid();
            print "Reaping $tid\n";
            $thread->join();
        }
    }
}

sub do_work {
    my $run = 1;
    $SIG{'STOP'} = sub { $run = 0; };
    while ($run) {
        sleep 1;
    }
}

1;