Perl threading de la méthode objet

Question

Je suis un débutant en Perl, alors soyez gentil :)

J'ai écrit le code suivant pour garder la trace de mes chiens lorsque je chasse (pas vraiment). Chaque fois qu'un chien trouve un canard, il signale le thread principal, qui collecte ensuite les informations de chacun des chiens de la meute.

#!/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;

La sortie attendue du code ci-dessus serait quelque chose comme :

Labrador : trouvé 1 canard !, Retriever : trouvé 0 canard !, Shepherd : trouvé 0 canard !

Labrador : trouvé 2 canards !, Retriever : trouvé 0 canards !, Berger : trouvé 0 canards !

Labrador : trouvé 3 canards !, Retriever : trouvé 0 canards !, Berger : trouvé 0 canards !

Labrador : trouvé 3 canards !, Retriever : trouvé 1 canard !, Shepherd : trouvé 0 canard !

Labrador : trouvé 4 canards !, Retriever : trouvé 1 canard !, Shepherd : trouvé 0 canard !

Labrador : trouvé 5 canards !, Retriever : trouvé 1 canard !, Berger : trouvé 0 canard !

Labrador : trouvé 6 canards !, Retriever : trouvé 1 canard !, Shepherd : trouvé 0 canard !

Labrador : trouvé 6 canards !, Retriever : trouvé 1 canard !, Shepherd : trouvé 0 canard !

Labrador : trouvé 6 canards !, Retriever : trouvé 1 canard !, Berger : trouvé 1 canard !

Au lieu de cela, j'obtiens ce qui suit :

Labrador : trouvé 1 canard !, Retriever : trouvé 0 canard !, Shepherd : trouvé 0 canard !

Labrador : trouvé 2 canards !, Retriever : trouvé 0 canards !, Berger : trouvé 0 canards !

Labrador : trouvé 3 canards !, Retriever : trouvé 0 canards !, Berger : trouvé 0 canards !

Labrador : trouvé 0 canard !, Retriever : trouvé 1 canard !, Shepherd : trouvé 0 canard !

Labrador : trouvé 4 canards !, Retriever : trouvé 0 canards !, Berger : trouvé 0 canards !

Labrador : trouvé 5 canards !, Retriever : trouvé 0 canards !, Berger : trouvé 0 canards !

Labrador : trouvé 0 canard !, Retriever : trouvé 2 canards !, Shepherd : trouvé 0 canard !

Labrador : trouvé 0 canard !, Retriever : trouvé 0 canard !, Shepherd : trouvé 1 canard !

Remarquez que le nombre de canards de chaque chien se remet à zéro lorsqu'un autre chien parle.

Avez-vous une idée de la note de bas de page que j'ai dû oublier en lisant le Lama ?

Answer 1

Le problème fondamental est que les variables Perl ne sont pas partagées par défaut, ce qui se combine avec un peu de bizarrerie sur le fait de savoir quel thread sert quel signal pour produire le résultat que vous voyez.

Lorsque vous créez vos fils de chasse, chacun d'entre eux reçoit sa propre copie du fichier @dogs et son contenu. C'est ainsi que fonctionnent les threads Perl : l'interpréteur et son état actuel -- @dogs , %SIG l'ouvert STDOUT -- est entièrement cloné. Pour voir comment cela fonctionne, considérez ce code :

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;

Le clonage se fait à threads->create temps, donc chacun de ces fils reçoit une version différente de @dogs à emporter avec elle. En conséquence, la liste des Dogs qui aboient quand l'un d'eux attrape un canard dépend du fil qui capte le signal ! (Notez également que vous pouvez déduire l'ordre dans lequel each a émis le hachage de cette sortie).

Retriever : trouvé 0 canard !, Labrador : trouvé 1 canard !

Retriever : trouvé 0 canard !, Labrador : trouvé 2 canards !

Retriever : a trouvé 1 canard !

Retriever : trouvé 0 canard !, Labrador : trouvé 3 canards !

Retriever : trouvé 0 canard !, Labrador : trouvé 4 canards !

Retriever : trouvé 0 canard !, Labrador : trouvé 0 canard !, Shepherd : trouvé 1 canard !

Retour à votre code : Lorsque le Labrador (thread 1) se réveille, il met à jour le fichier Labrador 's ducksfound et envoie un SIGUSR1 . Quelqu'un (et nous parlerons de qui dans une seconde) voit le signal et barks tous les Dogs . Mais le seul Labrador qui a été changé est celui du fil 1. Le site Retriever y Shepherd (threads 2 et 3 respectivement) n'ont pas vu la mise à jour de l'application Labrador 's ducksfound .

Pourquoi alors la valeur de ducksfound s'est imprimé correctement au début ? A cause de la façon dont vous avez installé le gestionnaire de signaux. Tu l'as installé au niveau du processus -- rappelle-toi que j'ai dit %SIG faisait partie des choses clonées sur vos fils. Donc chacun des threads a un gestionnaire pour USR1 qui cause tous les Dogs a bark . Lorsque vous envoyez USR1 a $$ le fil qui se trouve être éveillé à ce moment-là l'attrape. Et il se trouve que le fil qui a envoyé le signal est le fil qui est éveillé.

Et cela explique pourquoi lorsque le Retriever attrape son premier canard, son ducksfound est correcte mais la valeur Labrador ne l'est pas. Retriever attrape le canard dans le fil 2, qui envoie SIGUSR1 à lui-même et ensuite barks tous ses Dogs . Mais dans le fil 2, le Labrador n'a jamais été mis à jour, et donc l'écorce montre 0 pour Labrador et 1 pour Retriever .

Le problème des variables non partagées peut être contourné assez simplement par l'utilisation de la fonction threads::shared :

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

Maintenant, quand un thread met à jour un Dog tous les fils de discussion le verront et le fil de discussion qui gère le signal n'a pas d'importance. Ce qui est bien, car dans votre code, le "main thread" (thread 0) ne reprend jamais le contrôle. Cela peut être correct, mais conduit probablement à un comportement un peu plus étrange que celui auquel vous vous attendez.

Si vous voulez vraiment qu'il y ait un fil de gestion, vous devez probablement le créer explicitement :

# 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));

Notez que le simple fait de mettre en place un fil de gestionnaire sans partager votre Dogs se traduirait par un thread qui se réveille pour imprimer un tas de zéros. Vous devez faire les deux pour obtenir les résultats escomptés.