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

即我最终将对共享变量 headers 的引用传递给两个单独的线程

这些线程中的每一个都对哈希“ 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。

在perl线程中复制共享哈希的问题

1 个答案: