thread_test.pl

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

use Working::Daemon;
use IO::Socket;
use threads;
use threads::shared;
use Data::Dumper;

my $daemon = Working::Daemon->new();
$daemon->parse_options(
    'debug'               => 0 =>  "Debugging",
    'name'                => 'thread-test' => '',
    'minthreads'          => 5 => "Minimum workers",
    );
$daemon->do_action;

my $num_threads :shared;
my $min_threads = $daemon->options->{'minthreads'};
$num_threads = 10;


my $do_exit = 0;
my @threads;
my $admin = threads->create(\&admin);

# Admin interface                                                                                                  
sub admin {
    my $sock = IO::Socket::INET->new
        (Listen    => 5,
         LocalAddr => 'localhost',
         LocalPort => 9000,
         Proto     => 'tcp',
         Reuse     => 1
        );
    while(my $connection = $sock->accept) {
        $connection->print(Dumper({ num_threads    => \$num_threads }));
        $num_threads-- if $num_threads > $min_threads;
        close($connection);
    }
}

while(1)  {
    my $curr_size = scalar(@threads);
    if ($curr_size > $num_threads && $curr_size > $min_threads ) {
        print "Removing thread\n";
        my $thread = unshift(@threads);
        $thread->detach();
    }
    if ($curr_size < $num_threads) {
        print "Creating new thread\n";
        push @threads, threads->new(\&do_work);
    }
    sleep 1;
}

sub do_work {
    my $count = 0;
    while (!threads->is_detached()) {
        my $tid = threads->tid();
        print "In thread: $tid   ";
        print "$count\n";
        sleep 1;
        $count++;
    }
}

exit;

1;