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; 
} 
}