Perl gwintowania metody obiektu

Question

Perl rekrut tutaj, więc proszę być łagodne :)

Pisałem następujący kod do śledzenia moich psów kiedy poluję (nie bardzo). Za każdym razem, gdy pies znajduje kaczkę, sygnalizuje główną nić, która zbiera informacje od każdego z psów w paczce.

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

Oczekiwany wyjście powyższego kodu będzie coś takiego:

Labrador: znaleziono 1 kaczek !, Retriever: znaleziono 0 kaczki !, Shepherd: znaleziono 0 kaczki!

Labrador: znaleziono 2 kaczki !, Retriever: znaleziono 0 kaczek !, Pasterz: znaleziono 0 kaczek!

Labrador: znaleziono 3 kaczki !, Retriever: znaleziono 0 kaczek !, Pasterz: znaleziono 0 kaczek!

Labrador: znaleziono 3 kaczki !, Retriever: znaleziono 1 kaczki !, Pasterz: znaleziono 0 kaczek!

Labrador: znaleziono 4 kaczki !, Retriever: znaleziono 1 kaczki !, Pasterz: znaleziono 0 kaczek!

Labrador: znaleziono 5 kaczek !, Retriever: znaleziono 1 kaczki !, Pasterz: znaleziono 0 kaczek!

Labrador: znaleziono 6 kaczek !, Retriever: znaleziono 1 kaczki !, Pasterz: znaleziono 0 kaczek!

Labrador: znaleziono 6 kaczek !, Retriever: znaleziono 1 kaczki !, Pasterz: znaleziono 0 kaczek!

Labrador: znaleziono 6 kaczek !, Retriever: znaleziono 1 kaczki !, Pasterz: znaleziono 1 kaczkę!

Zamiast tego, co mam jest następujące:

Labrador: znaleziono 1 kaczek !, Retriever: znaleziono 0 kaczki !, Shepherd: znaleziono 0 kaczki!

Labrador: znaleziono 2 kaczki !, Retriever: znaleziono 0 kaczek !, Pasterz: znaleziono 0 kaczek!

Labrador: znaleziono 3 kaczki !, Retriever: znaleziono 0 kaczek !, Pasterz: znaleziono 0 kaczek!

Labrador: znaleziono 0 kaczek !, Retriever: znaleziono 1 kaczki !, Pasterz: znaleziono 0 kaczek!

Labrador: znaleziono 4 kaczki !, Retriever: znaleziono 0 kaczek !, Pasterz: znaleziono 0 kaczek!

Labrador: znaleziono 5 kaczek !, Retriever: znaleziono 0 kaczek !, Pasterz: znaleziono 0 kaczek!

Labrador: znaleziono 0 kaczek !, Retriever: znaleziono 2 kaczki !, Pasterz: znaleziono 0 kaczek!

Labrador: znaleziono 0 kaczek !, Retriever: znaleziono 0 kaczek !, Pasterz: znaleziono 1 kaczki!

Zauważ, że liczba kaczych psów każdego psa jest zerowa, gdy mówi inny pies.

Wszelkie spostrzeżenia, co do których szczególności przypis Musiałem pomijane podczas czytania Llama?

Answer 1

Podstawowym problemem jest to, że zmienne Perl nie są udostępniane domyślnie, co łączy się z odrobiną tajemniczości o który wątek jest obsługa, która sygnalizuje produkować wynik pan widzi.

Podczas tarła swoje wątki myśliwskich, każdy z nich dostanie swój własny egzemplarz @dogs i jego zawartości. Tak właśnie działają wątki Perla: interpreter i jego obecny stan - @dogs, %SIG, otwarty STDOUT - jest sklonowany cały. Aby zobaczyć jak to działa, należy rozważyć ten kod:

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; 

Klonowanie dzieje się threads->create czasu, więc każdy z tych wątków jest coraz inna wersja @dogs wziąć z nim. W konsekwencji lista Dogs, która szczeka, gdy jeden z nich złapie kaczkę, zależy od tego, który wątek złapie sygnał! (Należy również pamiętać, że można wywnioskować, kolejność, w jakiej each stało emitować hash z tego wyjścia.)

Retriever: znaleziono 0 kaczek !, Labrador: znaleziono 1 kaczki!

Retriever: znaleziono 0 kaczek !, Labrador: znaleziono 2 kaczki!

Retriever: znaleziono 1 kaczki!

Retriever: znaleziono 0 kaczek !, Labrador: znaleziono 3 kaczki!

Retriever: znaleziono 0 kaczek !, Labrador: znaleziono 4 kaczki!

Retriever: znaleziono 0 kaczek !, Labrador: znaleziono 0 kaczek !, Pasterz: znaleziono 1 kaczki!

Powrót do kodu: Kiedy Labrador gwint (gwint 1) budzi się, że aktualizuje „s ducksfoundLabrador i wysyła SIGUSR1. Ktoś (i będziemy mówić więcej o tym, kto w sekundę) widzi sygnał i barks wszystkie . Jednak jedyną zmienioną wersją Labrador jest ta z wątku 1. Gwinty Retriever i Shepherd (odpowiednio wątki 2 i 3) nie widziały aktualizacji Labrador 's ducksfound.

Dlaczego w takim razie najpierw jest drukowana prawidłowo wartość ducksfound? Z powodu sposobu zainstalowania obsługi sygnału. Zainstalowałeś go w całym procesie - pamiętaj, że powiedziałem, że wśród rzeczy sklonowanych do twoich wątków była %SIG. Więc każdy z wątków ma obsługę dla USR1, która powoduje, że wszystkie Dogs do bark. Kiedy wyślesz USR1 do $$, w zależności od tego, w którym momencie nadeszła w danym momencie wątek, zostanie ona przechwycona. I tak się składa, że ​​wątek, który wysłał sygnał, jest czuwaniem.

A to wyjaśnia, dlaczego kiedy Retriever łapie swoją pierwszą kaczkę, jego wartość ducksfound jest poprawna, ale wartość Labrador nie jest poprawna. Retriever łapie kaczkę w wątku 2, która wysyła SIGUSR1 do siebie, a następnie barks wszystkie jej Dogs. Ale w wątku 2, Labrador nigdy nie był aktualizowany, więc kora pokazuje 0 dla Labrador i 1 dla Retriever.

Problem zmiennych niepodświetlonych można zdobyć wokół dość łatwo poprzez zastosowanie threads::shared:

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

Teraz gdy aktualizuje jeden wątek na Dog wszystkie wątki ujrzy on i tak nie ma znaczenia, który wątek jest obsługa sygnału. Co jest dobre, ponieważ w twoim kodzie "główny wątek" (wątek 0) nigdy nie odzyska kontroli. To może być w porządku, ale prawdopodobnie prowadzi do nieco dziwniejszych zachowań, niż się spodziewasz.

Jeśli rzeczywiście chcą tam istnieć wątek menedżera, prawdopodobnie trzeba tarło go wyraźnie:

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

Należy pamiętać, że tylko wprowadzenie w wątku menedżera bez udostępniania Dogs doprowadziłoby do wątku, który budzi się wydrukować kilka zer. Musisz zrobić oba, aby uzyskać oczekiwane rezultaty.