проблемы с копированием общего хэша в perl-потоках

Question

Я столкнулся с тем, что я чувствую странное поведение общего хеша в perl и нуждался в некоторой помощи в его понимании.

Фактическая проблема заключается в гораздо большей базе кода, и я попытался уменьшить ее до меньшего воспроизводимого скрипта.

Так по существу проблема я столкнулся, у меня есть общий переменный, которая выглядит на этих линиях:

my %headers :shared= map { lc($_) => $custom_headers->{$_} } keys %{$custom_headers}; 
my %task1_request :shared; 
$task1_request{count} = $count; 
$task1_request{header} = \%headers if(keys %headers); 

т.е. я в конечном итоге передать ссылку на разделяемых переменные заголовков два отдельных потоков

Каждый из этих потоков выполняет операции «только для чтения» по ссылке на хеш «заголовки».

Однако, похоже, проходя копию общей хэш-функции в потоке, как показано в примере ниже:

iterate_header($request->{count},%{$request->{header}}); 

sub iterate_header 
{ 
    my $count = shift; 
    my $current_count = scalar(@_); 
    if($count != $current_count) { 
     print STDERR "Test failed Expected: $count, Actual : $current_count \n"; 
    } 
    else { 
     print STDERR "Test passed\n" ; 
    } 
} 

приводит к скопированной хэш коррумпированности т.е. @_ в iterate_header является коррумпированным.

Мне кажется, что на итераторе есть глобальное значение для общего хэша, в результате копия не является потокобезопасной. Однако вышеизложенное - это просто неосторожное предположение с моей стороны, и я надеюсь, что кто-то может помочь выяснить, почему копирование общего хэша вызывает это кажущееся странным поведение, и если это ожидается?

Скрипт репродуктор ниже:

use strict; 
use warnings; 
use threads; 
use threads::shared; 
use Thread::Queue; 

#should run test_count * 2 times 
sub iterate_header 
{ 
    my $count = shift; 
    my $current_count = scalar(@_); 
    if($count != $current_count) { 
     print STDERR "Test failed Expected: $count, Actual : $current_count \n"; 
    } 
    else { 
     print STDERR "Test passed\n" ; 
    } 
} 

sub request_loop { 
    my ($request_queue) = @_; 

    # wait for the next reuest... 
    while (defined(my $request = $request_queue->dequeue())) { 
     my %result :shared; 
     if(exists($request->{header})) { 
      iterate_header($request->{count},%{$request->{header}}); 
     } 
     last if(exists($request->{exit})); 
     $result{is_success} = "200"; 
    } 
} 

# Main program 
# create thread queues 
my $task1_request_queue = Thread::Queue->new(); 
my $task2_request_queue = Thread::Queue->new();  

# start worker threads 
my $task1_worker = threads->create(\&request_loop, $task1_request_queue); 
my $task2_worker = threads->create(\&request_loop, $task2_request_queue); 

# a high number to ensure tests fail 
my $test_count = 100; 
my $custom_headers = { 
     "key" => "558193F28878E5FE", 
     "username" => "Mastodon", 
     "real_username" => "Mastodon", 
     "type" => "EMPLOYEE", 
     "expiration" => "1434556278", 
     "env" => "save it", 
     "for" => "some ip", 
     "long-string" => "This islong string", 
     "state" => "internal", 
     "account" => "home", 
     "original_account" => "home", 
     "key" => "MCwCFAPOE74uvXso5alKytqjlfpdqeY4AhRpDeIMLCAk3ciBcyDXLdnyZjC/7Q==", 
     "charset" => "iso-8859-1,*,utf-8", 
     "agent" => "Mozilla/5.0 (Windows NT 6.1; WOW64) AppleWebKit/535.19 (KHTML, like Gecko) Chrome/18.0.1025.166 Workstation/2013.9.213.116 Safari/535.19", 
     "accept" => "application/json, text/plain, */*", 
     "encoding" => "gzip,deflate", 
     "language" => "en-us,en", 
     "cookie" => "TS01375c99=012e7f4fa1e82941689f22669e2e6403ce1c75f9f8c7cb86de86c19a887f61a1109c6e2aae", 
     "created" => "1434555378", 

    }; 


my @data = %{$custom_headers}; 
my $count = scalar(@data); 
print STDERR "Expected Count for all tests:$count\n"; 
for(my $i = 0;$i < 2; $i++) { 
    my %headers :shared= map { lc($_) => $custom_headers->{$_} } keys %{$custom_headers}; 
    #add to task1 q 
    {  

     my %task1_request :shared; 
     $task1_request{count} = $count; 

     $task1_request{header} = \%headers if(keys %headers); 

     $task1_request_queue->enqueue(\%task1_request); 
    } 

    # add to task2 q 
    { 
     my %task2_request :shared; 
     $task2_request{count} = $count; 

     $task2_request{header} = \%headers if(keys %headers); 
     $task2_request_queue->enqueue(\%task2_request); 
    } 
} 

my %end_request :shared = (exit => 1); 
$task1_request_queue->enqueue(\%end_request); 
$task2_request_queue->enqueue(\%end_request); 

$task1_worker->join(); 
$task2_worker->join(); 
print "testing done\n"; 

Пример вывода из работы теста:

[]$ perl thread_shared_issue.pl 
Expected Count for all tests:36 
Test passed 
Test passed 
Test passed 
Test passed 
testing done 
[]$ perl thread_shared_issue.pl 
Expected Count for all tests:36 
Test failed Expected: 36, Actual : 16 
Test failed Expected: 36, Actual : 60 
Test failed Expected: 36, Actual : 18 
Test failed Expected: 36, Actual : 56 
testing done 

Perl версии Испытано с

perl -version 

This is perl 5, version 12, subversion 5 (v5.12.5) built for x86_64-linux-thread-multi 

Answer 1

Два потока одновременно повторяют один и тот же хеш, поэтому оба они меняют свой итератор. Вы должны убедиться, что не более одного потока использует итератор хеширования за раз.

Я бы удалил все эти: общие и используемые Thread :: Queue :: Any.