#!/usr/bin/perl
use threads ('yield',
            'stack_size' => 64*4096,
            'exit' => 'threads_only',
            'stringify');

sub start_thread {
   my @args = @_;
   print('Thread started: ', join(' ', @args), "\n");
}

##创建线程的方法
# my $thr = threads->create('func_name', ...);
# my $thr = threads->create(sub { ... }, ...);
# my $thr = threads->create(\&func, ...);
# The "->new()" method is an alias for "->create()".
my $thr = threads->create('start_thread', 'argument1', 'argument2');		#通过create创建线程。返回线程实例
$thr->join();				#等待线程结束
threads->create(sub { print("I am a thread\n"); })->join();					#创建一个线程，没有返回值。那这个线程实例如何访问呢？

my $thr2 = async { foreach (@ARGS) { print"$_\n"; } };								#通过async使用匿名子例程创建线程
$thr2->join();
if (my $err = $thr2->error()) {
   warn("Thread error: $err\n");
}

# 在隐式的列表环境中调用thread
my $thr3 = threads->create(sub { return (qw/a b c/); });
# 在显式的列表环境中调用thread
my $thr4 = threads->create({'context' => 'list'},
                         sub { return (qw/a b c/); });
# 由于创建线程时使用的子例程返回的是列表，所以这里的join函数返回的也是列表
my @results = $thr3->join();
print "@results\n";
# 把线程从主线程中分离出来
# $thr->detach();		##报错：Cannot detach a joined thread,因为$thr已经调用过join()
$thr4->detach();		##
$tid = $thr4->tid();
print "线程4ID：$tid\n";

# Get a thread's object
$thr6 = threads->self();
$thr7 = threads->object($tid);

# Get a thread's ID
$tid = threads->tid();
$tid = "$thr7";		#根据线程实例获得线程ID

# 给其他线程一个运行的机会
threads->yield();
yield();

# 返回未分离的线程列表
my @threads = threads->list();
my $thread_count = threads->list();

my @running = threads->list(threads::running);
my @joinable = threads->list(threads::joinable);

# 判断两个线程是相同
if ($thr4 == $thr2) {
   print "thread4 equals to thread2.\n";
}

# 管理线程栈大小
$stack_size = threads->get_stack_size();
$old_size = threads->set_stack_size(32*4096);

# Create a thread with a specific context and stack size
my $thr5 = threads->create({ 'context'    => 'list',
                           'stack_size' => 32*4096,
                           'exit'       => 'thread_only' },
                         \&start_thread);

# Get thread's context
my $wantarray = $thr->wantarray();
print $wantarray,"\n";

# Check thread's state
if ($thr5->is_running()) {
   sleep(1);
}
if ($thr5->is_joinable()) {
   $thr5->join();
}

# Send a signal to a thread
$thr5->kill('SIGUSR1');

# Exit a thread
threads->exit();										

my ($var, %hash, @array) :shared;
             my $bork;

             # Storing scalars
             $var = 1;
             $hash{'foo'} = 'bar';
             $array[0] = 1.5;

             # Storing shared refs
             $var = \%hash;
             $hash{'ary'} = \@array;
             $array[1] = \$var;

             # 不能把非共享变量的引赋给一个共享变量，下面这3句是错误的
             #   $var = \$bork;                    # ref of non-shared variable
             #   $hash{'bork'} = [];               # non-shared array ref
             #   push(@array, { 'x' => 1 });       # non-shared hash ref

my %hash :shared;
             if (is_shared(%hash)) {
                 print("\%hash is shared\n");
             }

             $hash{'elem'} = 1;
             if (is_shared($hash{'elem'})) {                          ##返回undef
                 print("\$hash{'elem'} is in a shared hash\n");
             }

 　　#  创建一个共享的'Foo' object
         my $foo :shared = shared_clone({});
         bless($foo, 'Foo');

         # 创建一个共享的 'Bar' object
         my $bar :shared = shared_clone({});
         bless($bar, 'Bar');

         # 把'bar' 放到 'foo'里面
         $foo->{'bar'} = $bar;

         # 通过线程重新bless the objects
         threads->create(sub {
             # Rebless the outer object
             bless($foo, 'Yin');

             # 不能直接 rebless the inner object
             #bless($foo->{'bar'}, 'Yang');

             # 重新取回然后 rebless the inner object
             my $obj = $foo->{'bar'};
             bless($obj, 'Yang');
             $foo->{'bar'} = $obj;

         })->join();

         print(ref($foo),          "\n");    # Prints 'Yin'
         print(ref($foo->{'bar'}), "\n");    # Prints 'Yang'
         print(ref($bar),          "\n");    # Also prints 'Yang'

 my @arr = qw(foo bar baz);
         share(@arr);
         # @arr is now empty (i.e., == ());

         # Create a 'foo' object
         my $foo = { 'data' => 99 };
         bless($foo, 'foo');

         # Share the object
         share($foo);        # Contents are now wiped out
         print("ERROR: \$foo is empty\n")
             if (! exists($foo->{'data'}));

use Thread::Semaphore;
           my $s = Thread::Semaphore->new();
           $s->down();   # P操作
           # The guarded section is here
           $s->up();     # V操作

           # Decrement the semaphore only if it would immediately succeed.
           if ($s->down_nb()) {
               # 邻界区在此
               $s->up();
           }

           # 强制降低信号量即使他成为负数
           $s->down_force();

           # 创建信号量时指定·初始值
           my $s = Thread::Semaphore->new($initial_value);
           $s->down($down_value);
           $s->up($up_value);
           if ($s->down_nb($down_value)) {
               ...
               $s->up($up_value);
           }
           $s->down_force($down_value);

use strict;
           use warnings;

           use threads;
           use Thread::Queue;

           my $q = Thread::Queue->new();    # 创建一个空的线程队列

           # Worker线程
           my $thr = threads->create(sub {
                                       while (my $item = $q->dequeue()) {
                                           #处理$item
                                       }
                                    })->detach();

           # 向线程发送 work
           $q->enqueue($item1, ...);


           # 计算队列中有多少项
           my $left = $q->pending();

           # 非阻塞地出队
           if (defined(my $item = $q->dequeue_nb())) {
               # 处理 $item
           }

           # 获取队列中的第2项，注意并没有进行出几队操作
           my $item = $q->peek(1);

           # 在队头后面插入两个元素
           $q->insert(1, $item1, $item2);

           # 提取队列中的最后两个元素
           my ($item1, $item2) = $q->extract(-2, 2);

my @ary :shared = qw/foo bar baz/;
           $q->enqueue(\@ary);

           my $obj = &shared({});
           $$obj{'foo'} = 'bar';
           $$obj{'qux'} = 99;
           bless($obj, 'My::Class');
           $q->enqueue($obj);

         {
               lock($q);   # 销往队列，以防止其他线程中修改和删除队列元素
               my $item = $q->peek();
               if ($item ...) {
                   ...
               }
           }
           # 离开块之后，队列变量自动解锁