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