perl多线程

http://blog.csdn.net/aldenphy/article/details/6135828

简单多线程结构分析  
============================================================================================================  
----------------------------------------------------------------------  
use thread;  
#导入thread包  
----------------------------------------------------------------------  
$thread=thread->new(/&aaa,'aaa','bbb');  
#新建多线程对象变量$thread，第一个参数是以子程序方式的结构体，后面跟的  
#都是调用前面的那个子程序结构的实际参数。  
----------------------------------------------------------------------  
$result=$thread->join();  
#召回线程的返回。无参数，$result变量为返回值。注意:线程本身不能调用自  
#己的join()方法。  
----------------------------------------------------------------------  
$thread->detach();  
#使分线程与主线程分离。无返回值，无参数。注意:调用此步后就不能再在其他  
#线程调用关于这个线程的join()方法了。  
----------------------------------------------------------------------  
@thread_list=$thread->list();  
#返回正在运行的线程。无参数，返回值@thread_list为正在运行的线程的列表。  
----------------------------------------------------------------------  
$thread=thread->self();  
#返回当前线程本身。无参数，返回值为当前线程的对象变量。  
----------------------------------------------------------------------  
$tid=$thread->tid();  
#返回多线程对象的tid值(附:tid为线程独有的id记号)。无参数，返回值为线程  
#的tid值。  
----------------------------------------------------------------------  
lock($aaa);  
#把进程中的某个变量锁住，以便某个线程不能改变其值。  
----------------------------------------------------------------------  
$thread=async{block};  
#创造新线程的另一种方式。参数block为命令行格式，返回值为线程对象变量。  
----------------------------------------------------------------------  
============================================================================================================= 
#实验:因为至今还不能很好地‘凌驾’这种‘技术’，因此不能提供良好的实验代码给大  
#家，望大家见谅。  
#!usr/bin/perl -w  
use io::socket;                                 #导入io::socket包  
use thread;                                     #导入thread多线程处理包  
$sock=io::socket::inet->new(listen=>10,         #新建一个tcp、端口为5354、有10个监听队列的socket  
                            localport=>5354,  
                            proto=>'tcp');  
while(1){                                       #进入典型的服务器循环体  
next unless $client=$sock->accept;              #accept  
thread->new(/&iando,$client);                   #成功accept后，进入一个线程，线程为i/o会话部分  
$client->close;                                 #结束客户端的会话  
}  
$sock->close;                                   #最后结束服务端socket  
exit 1;                                         #退出程序  

sub iando{                                      #线程核心子程序  
my $handle=shift;                               #将线程调用的参数吸入到变量$handle  
thread->self->detach;                           #分离线程  
print $handle "hi!/n";                          #i/o操作  
return;                                         #返回主线程  
}  
#记住:服务端所谓‘多线程’中的线程其实是指整个socket中的i/o会话部分。  
#注意线程核心子进程基本步骤:截取调用参数->分离主线程->i/o  
============================================================================================================= 
注意:在perl5.x版下只有win32与部分*nix支持多线程，macperl与部分*nix还是不支持的。       

---

 

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