Multithreading 对象方法的Perl线程

这里是Perl新手，所以请温柔一点：）

我已经编写了以下代码，以便在打猎时跟踪我的狗（不是真的）。每当一只狗找到一只鸭子，它就会向主线发送信号，然后主线从包中的每只狗那里收集信息

#!/usr/bin/env perl

use strict;
use warnings;
use v5.14;

use threads;

{
    package Dog;

    sub new {
        my ($class, $name, $dt) = @_;
        my $self = {
            dt => $dt,      # will find a duck every $dt seconds
            name => $name,
            ducksfound => 0
        };
        bless $self, $class;
    }

    sub hunt {
        #
        # the "thread" method -- the dog will hang around for $dt seconds,
        # then alert the main thread by sending SIGUSR1
        #
        my $self = shift;
        while (1) {
            sleep $self->{dt};
            $self->{ducksfound} += 1;
            kill USR1 => $$;
        }
    }

    sub bark {
        my $self = shift;
        sprintf "%s: found %d ducks!", ($self->{name}, $self->{ducksfound});
    }

    1;
}

my @dogs;

$SIG{USR1} = sub {
    say join ", ", map { $_->bark } @dogs;
};


push @dogs, Dog->new("Labrador", 1);
push @dogs, Dog->new("Retriever", 2);
push @dogs, Dog->new("Shepherd", 3);

threads->create( sub { $_->hunt } ) for @dogs;
$_->join for threads->list;

上述代码的预期输出如下：

拉布拉多：发现1只鸭子！，寻回犬：发现0只鸭子！，牧羊人：找到0只鸭子

拉布拉多：发现了2只鸭子！，寻回犬：发现0只鸭子！，牧羊人：找到0只鸭子

拉布拉多：发现了3只鸭子！，寻回犬：发现0只鸭子！，牧羊人：找到0只鸭子

拉布拉多：发现了3只鸭子！，寻回犬：发现1只鸭子！，牧羊人：找到0只鸭子

拉布拉多：发现了4只鸭子！，寻回犬：发现1只鸭子！，牧羊人：找到0只鸭子

拉布拉多：发现了5只鸭子！，寻回犬：发现1只鸭子！，牧羊人：找到0只鸭子

拉布拉多：找到6只鸭子！，寻回犬：发现1只鸭子！，牧羊人：找到0只鸭子

拉布拉多：找到6只鸭子！，寻回犬：发现1只鸭子！，牧羊人：找到0只鸭子

拉布拉多：找到6只鸭子！，寻回犬：发现1只鸭子！，牧羊人：找到1只鸭子

相反，我得到的是以下信息：

拉布拉多：发现1只鸭子！，寻回犬：发现0只鸭子！，牧羊人：找到0只鸭子

拉布拉多：发现了2只鸭子！，寻回犬：发现0只鸭子！，牧羊人：找到0只鸭子

拉布拉多：发现了3只鸭子！，寻回犬：发现0只鸭子！，牧羊人：找到0只鸭子

拉布拉多：发现了0只鸭子！，寻回犬：发现1只鸭子！，牧羊人：找到0只鸭子

拉布拉多：发现了4只鸭子！，寻回犬：发现0只鸭子！，牧羊人：找到0只鸭子

拉布拉多：发现了5只鸭子！，寻回犬：发现0只鸭子！，牧羊人：找到0只鸭子

拉布拉多：发现了0只鸭子！，寻回犬：发现2只鸭子！，牧羊人：找到0只鸭子

拉布拉多：发现了0只鸭子！，寻回犬：发现0只鸭子！，牧羊人：找到1只鸭子

注意，当另一只狗说话时，每只狗的鸭子数是如何重置为零的

---

在阅读Llama时，我必须掩盖哪些特定脚注的任何见解？

基本问题是Perl变量在默认情况下是不共享的，这与关于哪个线程正在处理哪个信号以产生您看到的结果的一点奇怪相结合

当你繁殖狩猎线程时，每个线程都会获得自己的

@dogs

副本及其内容。这正是Perl线程的工作方式：解释器及其当前状态--

@dogs

，

%SIG

，打开的

标准输出

--被完整克隆。要了解它是如何工作的，请考虑这个代码：

my %dog_decls = (
    Labrador    => 1,
    Retriever   => 2,
    Shepherd    => 3,
);

while (my ($name, $delay) = each %dog_decls) {
    my $dog = Dog->new($name, $delay);
    push @dogs, $dog;
    threads->create(sub { $dog->hunt });
}

$_->join for threads->list;

克隆发生在

threads->create

时间，因此每个线程都有一个不同版本的

@dogs

。因此，当其中一只狗抓住鸭子时，吠叫的狗的列表取决于哪条线抓住了信号！（还请注意，您可以推断每个从该输出发出散列的顺序。）

寻回犬：发现0只鸭子！，拉布拉多：找到1只鸭子

寻回犬：发现0只鸭子！，拉布拉多：找到2只鸭子

寻回犬：发现1只鸭子

寻回犬：发现0只鸭子！，拉布拉多：发现了3只鸭子

寻回犬：发现0只鸭子！，拉布拉多：发现了4只鸭子

寻回犬：发现0只鸭子！，拉布拉多：发现了0只鸭子！，牧羊人：找到1只鸭子

回到您的代码：当

拉布拉多

线程（线程1）唤醒时，它更新

拉布拉多

的

ducksfound

，并发送

SIGUSR1

。有人（稍后我们将更多地讨论谁）看到了信号并吠叫所有的狗。但是唯一被更改的

拉布拉多

是线程1中的一个。

Retriever

和

Shepherd

线程（分别为线程2和线程3）未看到

Labrador

的

ducksfound

的更新

为什么

ducksfound

的值一开始打印正确？因为你安装信号处理器的方式。您在进程范围内安装了它--还记得我说过

%SIG

是克隆到您的线程中的东西之一。因此，每个线程都有一个用于

USR1

的处理程序，它使所有

狗

发出

吠声。当您将
USR1
发送到
$
时，无论哪个线程恰好在那一刻处于唤醒状态，都会捕获它。碰巧发送信号的线程是唤醒的线程

这就解释了为什么当
寻回犬
捕捉到它的第一只鸭子时，它的
ducksfound
值是正确的，而
拉布拉多犬
的值则不正确
Retriever
在线程2中捕获鸭子，它将
SIGUSR1
发送到自身，然后
吠叫它所有的
狗
。但是在线程2中，
拉布拉多犬
从未更新过，因此树皮显示0表示
拉布拉多犬
，1表示
寻回犬

非共享变量的问题可以通过使用
threads:：shared
：

use threads::shared;
...
my @dogs :shared;
...
push @dogs, shared_clone(Dog->new("Labrador",  1));

现在，当一个线程更新一个
狗时，所有线程都会看到它，因此哪个线程在维护信号并不重要。这很好，因为在代码中，“主线程”（线程0）永远无法恢复控制。这可能没问题，但可能会导致比您预期的稍微奇怪的行为

如果确实希望存在管理器线程，则可能需要显式生成它：

# in Dog::new
        my ($class, $name, $hunter, $dt) = @_;
        ...
        hunter => $hunter,
# in Dog::hunt
        $self->{hunter}->kill('USR1');
# in main
my $hunter_thread = threads->create(
    sub {
        local $SIG{USR1} = sub {
            say join ", ", map { $_->bark } @dogs;
        };
        while (1) { usleep 100_000 } # higher resolution than hunt events
    }
);
...
push @dogs, shared_clone(Dog->new("Labrador", $hunter_thread, 1));

请注意，只需输入一个管理器线程而不共享您的
狗
，将导致一个线程醒来打印一堆零。要获得预期的结果，您需要同时做这两件事。
对于Perl新手来说，这是一个非常好的问题。：）信号和线程不能很好地混合。你不能给一个特定的线程发信号。更新：线程文档似乎不同意，但显示使用
$thr->kill
，而不是普通的kill@JonahBishop--那