perl实现多线程

#用perl实现多线程（转）


use strict;
use English '-no_match_vars';
use Errno qw(EAGAIN);
use threads;
use threads::shared;
my $items = 20; #需要处理的任务数
my $maxchild = 65; #最多线程数（1-65），perl最多允许64个子线程，加上主线程因此最多65个线程
my $pid;
my $forks: shared = 1; #当前线程数
print "startn";
my $item: shared = 0; #当前处理任务序号,起始序号为0
my $myid = 1; #当前线程序号
my $main_pid = $PID;
sub subprocess;
#最多$maxchild个线程完成$items项任务
while ($item<$items) {
FORK: {
#select undef,undef,undef,0.1;
if (($forks<$maxchild) && ($PID == $main_pid)) { #必须只允许主线程产生子线程
if ($pid = fork) { #主线程处理
$| = 1;
$forks++;
$myid++;
print "Starting Sub_Process:($pid/$PID)n";
}elsif (defined $pid) { #子线程处理
$| = 1;
last unless (subprocess);
}elsif ($! == EAGAIN) { #子线程未创建成功
print "$!$forksn";
# EAGAIN is the supposedly recoverable fork error
sleep 5;
redo FORK;
}else { #不能创建子线程
# weird fork error
die "Can't fork: $!n";
}
}else { #所有线程处理
last unless (subprocess);
}
}
}


sub subprocess {
#由于$item是共享的且每个线程都能对其进行修改，因此为了保证当前线程任务序号的正确，必须将$item转入局部变量存储
my $sid; #存储线程当前处理任务序号。
{
lock($item);
$sid = $item;
$item++ if ($item < $items);
}
if ($sid < $items) { #任务处理
print "Child process($PID/$myid) start :$sid/$forksn";
print "$sidn";
sleep 1;
print "Child process($PID/$myid) end :$sid/$forksn";
return 1;
}elsif ($main_pid == $PID) { #主线程结束
wait; #结束前等待所有子线程结束
print "Main process $$/$myid endn";
exit 1;
}else { #子线程结束
print "Child process($PID/$myid) exit :$sid/$forksn";
exit 1;
}
}