threads, Thread::Semaphoreを使ったperlサンプルコード

#!/usr/bin/perl

use strict;
use warnings;
use Getopt::Long;
use FindBin;
my $mypath = $FindBin::RealBin;
use File::Basename;
my ($myname) = fileparse($0);
use threads;                            #read perlthrtut (perl thread tutorial) for details
use Thread::Semaphore;

my @ref_list;                           #each thread object will be stored here

#
# Option handling
#
&show_help if ($#ARGV < 0);
my $help = '';          #Default : false
my $verbose = '';       #Default : false
my $debug = '';         #Default : false
my $thread = 1;         # --thread n
GetOptions (            #Getopt::Long::GetOptions()
        'help' => \$help
        , 'verbose' => \$verbose
        , 'debug' => \$debug
        , 'thread=i' => \$thread        #integer expected
                ) or die $!;
if ($help) {
        &show_help();
}


#
# Main
#
my $sema = Thread::Semaphore->new();    #read perlthrtut (perl thread tutorial) for details
&create_threads($thread, $sema);                        #each thread obj stored in @ref_list
&progress_report();
&join_threads();                                #joins all the remaining thread



#
# Sub routines
#
sub show_help() {
        print <<"ENDOFHELP";
 ************************* How to use *************************
$mypath/$myname [options] [-- other_arguments_for_script]
options:                Processed by Getopt::Long
        -help           Displays this help message.
        -verbose        Displays more information.
        -debug          Debug mode. More and more information.
        -thread n       Number of parts which input file severed into.

 **************************************************************
ENDOFHELP
        exit;
}
sub create_threads() {
        my $max = shift;
        for (my $i = 1; $i <= $max; $i++) {
                my ($thr) = threads->create(\&token_func, "hoge.$i", "piyo.$i");
                push @ref_list, $thr;
        }
}
sub token_func() {
        my $tid = threads->tid();
        $sema->down();
        print "semaphore down by thread $tid.\n" if ($verbose);
        my @args = @_;
        my $piyo = join(",", @args);
        sleep 2;
        print "semaphore up by thread $tid.\n" if ($verbose);
        $sema->up();
        return ($piyo);
}
sub progress_report(){          #supposes all threads finish correctly
        while (my @running = threads->list(threads::running)) {
                my $count = scalar(@running);
                print "$count running thread(s)\n";
                sleep 5;
        }
}
sub join_threads() {
        foreach (threads->list()) {     #threads->list() returns undetached thread object
                my $tid = $_->tid;
                my @returned = $_->join();
                print "\$tid $tid joined. Returned: ", join (",", @returned), " : ", __FILE__, ":", __LINE__, "\n" if ($verbose);
        }
}