参考:
Perl 中的线程: https://www.ibm.com/developerworks/cn/linux/l-cn-perl-thread/

#!/usr/bin/perl -w
# multi-thread train
#
#package MulThrd;

use Config; # 动态获取线程模型
use threads ('exit' => 'threads_only'); # 全局设置，防止线程体内调用exit函数，将所有线程都结束
use strict;
use SqlTest;
use threads::shared;

# 线程变量的共享，用模块threads::shared
# 创建线程: Thread->new(\&start_sub, @start_args);
# see: https://www.ibm.com/developerworks/cn/linux/l-cn-perl-thread/
#

# 定义线程间共享变量
my $thdshare :shared = 10;

my $thdsum=3;
#my $cnt=0;
my @thrds;

if( $Config{useithreads} ) {
printf("Hello ithreads\n");
}
elsif( $Config{use5005threads} ) {
printf("Hello 5005threads\n");
}
else {
printf("Can not support thread in your perl environment\n");
exit( 1 );
}

# create thread
for (my $cnt=0;$cnt<$thdsum;$cnt++){
print "start one thread:$cnt!".`date`;
my $t;
# create()
$t = threads->new(\&start_thread,$cnt);
# 如果不声明exit=thread_only，如果在线程中调用了exit()方法，则所有线程都会结束
# 或者use threads ('exit' => 'threads_only');显示设定，全局范围内都有效
#$t = threads->new({'exit'=>'thread_only'},\&start_thread,$cnt);

# async 优缺点？
# $t = async{print "async create thread\n";};

$thrds[$cnt] = $t;
}

# join 必须等待线程执行完，否则阻塞主线程
# detach 将此线程从主线程剥离，主线程不关心该线程的执行结果，同时无法使用join获取执行结果
# 如果不进行join或detach，则线程资源不会被释放.
my $log;
foreach my $thrd (@thrds){
#print "join one thread!".`date`;
my $tid = $thrd->tid();
$log = "thread not do";
print "$tid $log \n";

# $thrd->detach();
# next;
# get thread execute result
my $res = $thrd->join();
#print "thread $tid join res: $res! \n";

$log = "thread have do";
print "$tid $log \n";

# recycle thread
# $thrd->detach();
}

# thread body
sub start_thread{
my ($info) = @_;
$thdshare--;
print "start_thread input $info!$thdshare |".`date`;

sleep 3;
# SqlTest Module
&do_sql_test();

sleep 1;
return time;
}

=pod
my $mhofile = 't';
open(MHO,$mhofile);
my @mholist=;

foreach my $mho (@mholist){
next unless defined $mho;

print "start one thread";
$thrds[$cnt] = Thread->new(\&start_thread,$mho);
$cnt++;
}
=cut

在的代码块执行结束之后，也就是锁被隐式释放之时。例如

清单 10. 线程中的锁机制

 use threads::shared; 

 # in thread 1 
 { 
    lock( $share );        # lock for 3 seconds 
    sleep(3);               # other threads can not lock again 
 } 
 # unlock implicitly now after the block 

 # in thread 2 
 { 
    lock($share);          # will be blocked, as already locked by thread 1 
    $share++;               # after thread 1 quit from the block 
 } 
 # unlock implicitly now after the block

上面的示例中，我们在 thread 1 中使用 lock 方法锁住了一个普通的标量，这会导致 thread 2 在试图获取 $share 变量的锁时被阻塞，当 thread 1 从调用 lock 的代码块中退出时，锁被隐式地释放，从而 thread 2 阻塞结束，lock 成功以后，thread 2 才可以执行 $share++ 的操作。对于数组和哈希表来说，lock 必须用在整个数据结构上，而不是用在数组或哈希表的某一个元素上。例如

清单 11. 在数组或哈希表上使用锁机制

 use threads; 
 use threads::shared; 

 { 
    lock(@share);          # the array has been locked 
    lock(%hash);           # the hash has been locked 
    sleep(3);               # other threads can not lock again 
 } 

 { 
    lock($share[1]);     # error will occur 
    lock($hash{key});    # error will occur 
 }

假如一个线程对某一个共享变量实施了锁操作，在它没有释放锁之前，如果另外一个线程也对这个共享变量实施锁操作，那么这个线程就会被阻塞，阻塞不会被自动中止而是直到前一个线程将锁释放为止。这样的模式就带来了我们常见的死锁问题。例如

清单 12. 线程中的死锁

 use threads; 
 use threads::shared; 
 # in thread 1 
 { 
    lock($a);              # lock for 3 seconds 
    sleep(3);              # other threads can not lock again 
    lock($b);              # dead lock here 
 } 

 # in thread 2 
 { 
    lock($b);              # will be blocked, as already locked by thread 1 
    sleep(3);              # after thread 1 quit from the block 
    lock($a);              # dead lock here 
 }

死锁常常是多线程程序中最隐蔽的问题，往往难以发现与调试，也增加了排查问题的难度。为了避免在程序中死锁的问题，在程序中我们应该尽量避免同时获取多个共享变量的锁，如果无法避免，那么一是要尽量使用相同的顺序来获取多个共享变量的锁，另外也要尽可能地细化上锁的粒度，减少上锁的时间。

信号量

Thread::Semaphore 包为线程提供了信号量的支持。你可以创建一个自己的信号量，并通过 down 操作和 up 操作来实现对资源的同步访问。实际上，down 操作和 up 操作对应的就是我们所熟知的 P 操作和 V 操作。从内部实现上看，Thread::Semaphore 本质上就是加了锁的共享变量，无非是把这个加了锁的共享变量封装成了一个线程安全的包而已。由于信号量不必与任何变量绑定，因此，它非常灵活，可以用来控制你想同步的任何数据结构和程序行为。例如

清单 13. 线程中的信号量

 use threads; 
 use threads::shared; 
 use Thread::Semaphore; 

 my $s = Thread::Semaphore->new(); 
 $s->down();                # P operation 
 ... 
 $s->up();                  # V operation

从本质上说，信号量是一个共享的整型变量的引用。默认情况下，它的初始值为 1，down 操作使它的值减 1，up 操作使它的值加 1。当然，你也可以自定义信号量初始值和每次 up 或 down 操作时信号量的变化。例如

清单 14. 线程中的信号量

 use threads; 
 use Thread::Semaphore; 

 my $s = Thread::Semaphore->new(5); 
 printf("s = " . ${$s} . "\n");         # s = 5 
 $s->down(3); 
 printf("s = " . ${$s} . "\n");         # s = 2 
 ... 
 $s->up(4); 
 printf("s = " . ${$s} . "\n");         # s = 6

线程队列

Thread::Queue 包为线程提供了线程安全的队列支持。与信号量类似，从内部实现上看，Thread::Queue 也是把一个通过锁机制实现同步访问的共享队列封装成了一个线程安全的包，并提供统一的使用接口。Thread::Queue 在某些情况下可以大大简化线程间通信的难度和成本。例如在生产者 - 消费者模型中，生产者可以不断地在线程队列上做 enqueue 操作，而消费者只需要不断地在线程队列上做 dequeue 操作，这就很简单地实现了生产者和消费者之间同步的问题。例如

清单 15. 生产者 - 消费者模型中对线程队列的使用

 #!/usr/bin/perl 
 # 

 use threads; 
 use Thread::Queue; 

 my $q = Thread::Queue->new(); 

 sub produce { 
    my $name = shift; 
    while(1) { 
        my $r = int(rand(100)); 
        $q->enqueue($r); 
        printf("$name produce $r\n"); 
        sleep(int(rand(3))); 
    } 
 } 

 sub consume { 
    my $name = shift; 
    while(my $r = $q->dequeue()) { 
        printf("consume $r\n"); 
    } 
 } 

 my $producer1 = threads->create(\&produce, "producer1"); 
 my $producer2 = threads->create(\&produce, "producer2"); 
 my $consumer1 = threads->create(\&consume, "consumer2"); 

 $producer1->join(); 
 $producer2->join(); 
 $consumer1->join();

回页首

其他有用的非核心包

本文前面讨论的所有内容都在 Perl 线程核心包的范畴之内。其实 CPAN 上还有其他一些与线程相关的非核心包，它们往往也会给 Perl 线程的使用带来很大的便利，这里我们选出两个稍加介绍，抛砖引玉。

Thread::Pool 包允许你在程序中创建一批线程去完成多个类似的任务。例如当你希望创建一个多线程程序去完成检验 1000 个 ip 地址是否都能 ping 通的任务时，Thread::Pool 包可以给你带来便利。

Thread::RWLock 包为线程中的读写操作提供了锁机制的支持。例如当你有多个 reader 和 writer 线程共同访问某一个或几个文件时，Thread::RWLock 包可以给你带来便利。

回页首

总结

本文主要介绍了 Perl 中线程的使用方法，包括线程的创建、执行与消亡，如何在线程中使用共享变量并通过锁机制、信号量和线程队列的方法来实现线程间的同步。Perl ithreads 线程模型与主流线程模型最大的不同之处在于默认情况下任何数据结构都是非共享的，或者说 Perl 中的 ithreads 是一个“非轻量级”的线程模型。虽然这样的线程模型增加了程序的开销，但它并不会在线程的功能性上打折扣，同时它也使得线程间的通讯和共享变得更加简单。这也符合了 Perl 一贯的简单而强大的理念和原则。

笔记：perl 线程

信号量

线程队列

其他有用的非核心包

总结