Multithreading 在perl线程中复制共享哈希时出现问题

我遇到了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);

i、 e i最终将对共享变量头的引用传递给两个单独的线程

这些线程中的每一个都对哈希“头”的引用执行“只读”操作

但是，将共享哈希的副本传递给线程中的函数时，它看起来像是，如下例所示：

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" ;
    }
}

导致复制的哈希被损坏 i、 e iterate_头中的@_已损坏

在我看来，迭代器行中的某些内容对于共享哈希是全局的，因此副本不是线程安全的。然而，以上只是我一个鲁莽的假设，我希望有人能帮助澄清为什么复制共享哈希会导致这种看似奇怪的行为，如果这是预期的

复制程序脚本如下：

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

---

两个线程同时在同一个哈希上迭代，因此它们都在更改其迭代器。您需要确保一次使用哈希迭代器的线程不超过一个

---

我会删除所有这些：shared和use Thread:：Queue:：Any。

这是否意味着复制共享哈希不是线程安全的，应该锁定它？从直觉上看，复制似乎是一个只读操作，所以它很奇怪。是否有指定此操作的文档/代码？复制需要对哈希进行迭代，所以是的。//迭代器绑定到哈希而不是操作符的文档？也许不是直接的，但可以推断。“作为一个副作用，调用keys（）会重置散列的内部迭代器”。通过使用两个

对同一个散列进行迭代，您可以很容易地看到它。