multithreading - Perl 线程 : Array of hash issue

Question

我在尝试使用 perl 线程模块时遇到问题(我显然不擅长这个)。
我阅读了许多主题并尝试了一些“技巧”，但没有任何帮助。
我的目标是用几个哈希 (%memberInfo) 来完成我的 @allMember 数组。
这是我的代码的简化版本:

#!/usr/bin/perl
use strict ;
use warnings ;
use threads ;
use threads::shared ;

my %memberInfo:shared ;
my @member:shared ;
my @allMember:shared ;

my @list = ( 'toto:1.1.1.1:111', 'tata:2.2.2.2:222', 'titi:3.3.3.3:333') ;

@member = @list ;

my $nbThread = 5 ;
for ( 1..$nbThread ) { threads -> create ( \&job_to_parallelize ) ; }
foreach my $thr ( threads -> list() ) { $thr -> join(); }

sub job_to_parallelize {

  while ( my $member = shift(@member)) {
    my ($name,$ip,$port) = split(/:/,$member) ;

    $memberInfo{ip} = $ip ;
    $memberInfo{name} = $name ;
    $memberInfo{port} = $port ;
    push(@allMember,\%memberInfo) ;
           
  }
}

如果我插入 print Dumper(\%memberInfo) ;以上 push(@allMember,\%memberInfo) ;我有我想要的信息:

$VAR1 = {
          'ip' => '1.1.1.1',
          'name' => 'toto',
          'port' => '111'
        };
$VAR1 = {
          'ip' => '2.2.2.2',
          'name' => 'tata',
          'port' => '222'
        };
$VAR1 = {
          'ip' => '3.3.3.3',
          'name' => 'titi',
          'port' => '333'
        };

但如果我尝试 print Dumper(\@allMember) ;在我的脚本结束时(在我的“job_to_parallelize”函数之后)，信息只是克隆了 3 次的最后一个 %memberInfo 哈希:

$VAR1 = [
          {
            'ip' => '3.3.3.3',
            'name' => 'titi',
            'port' => '333'
          },
          {
            'ip' => '3.3.3.3',
            'name' => 'titi',
            'port' => '333'
          },
          {
            'ip' => '3.3.3.3',
            'name' => 'titi',
            'port' => '333'
          }
        ];

对于信息，我的@list 数组(在我的真实脚本中)是从一个大文件(数千个主机)中完成的。
我将主机放在@list 中，然后在我的共享@member 数组中创建一个副本。
我希望我足够清楚。
我哪里错了？
感谢您在这个问题上的帮助。

Answer 1

你清空@member通过执行 shift(@member) 在第一个线程中创建数组这里:

while ( my $member = shift(@member)) {

这样以下线程只会看到一个空数组。尝试以下修改:

use feature qw(say);
use strict;
use warnings;
use threads ;
use threads::shared ;
use Data::Dumper qw(Dumper);

my @allMember:shared;
my @member = ( 'toto:1.1.1.1:111', 'tata:2.2.2.2:222', 'titi:3.3.3.3:333') ;
my $nbThread = 5 ;
for ( 1..$nbThread ) { threads -> create ( \&job_to_parallelize ) ; }
foreach my $thr ( threads -> list() ) {
    $thr -> join();
}

sub job_to_parallelize {
  for my $member (@member) {
      my ($name,$ip,$port) = split(/:/,$member);
      {
          lock @allMember;
          my %memberInfo:shared = ( ip => $ip, name => $name, port => $port );
          push(@allMember,\%memberInfo);
      }
  }
}

print Dumper(\@allMember);

输出 :

$VAR1 = [
          {
            'port' => '111',
            'ip' => '1.1.1.1',
            'name' => 'toto'
          },
          {
            'port' => '222',
            'ip' => '2.2.2.2',
            'name' => 'tata'
          },
          {
            'port' => '333',
            'ip' => '3.3.3.3',
            'name' => 'titi'
          },
          {
            'ip' => '1.1.1.1',
            'port' => '111',
            'name' => 'toto'
          },
          {
            'ip' => '2.2.2.2',
            'port' => '222',
            'name' => 'tata'
          },
          {
            'name' => 'titi',
            'port' => '333',
            'ip' => '3.3.3.3'
          },
          {
            'name' => 'toto',
            'port' => '111',
            'ip' => '1.1.1.1'
          },
          {
            'port' => '222',
            'ip' => '2.2.2.2',
            'name' => 'tata'
          },
          {
            'name' => 'titi',
            'ip' => '3.3.3.3',
            'port' => '333'
          },
          {
            'ip' => '1.1.1.1',
            'port' => '111',
            'name' => 'toto'
          },
          {
            'name' => 'tata',
            'ip' => '2.2.2.2',
            'port' => '222'
          },
          {
            'port' => '333',
            'ip' => '3.3.3.3',
            'name' => 'titi'
          },
          {
            'port' => '111',
            'ip' => '1.1.1.1',
            'name' => 'toto'
          },
          {
            'ip' => '2.2.2.2',
            'port' => '222',
            'name' => 'tata'
          },
          {
            'ip' => '3.3.3.3',
            'port' => '333',
            'name' => 'titi'
          }
        ];

编辑 :
如果要清空 @member变量(我不清楚你是否想要那个)你可以试试这个:

use feature qw(say);
use strict;
use warnings;
use threads ;
use threads::shared ;
use Data::Dumper qw(Dumper);

my @allMember:shared ;
my $lockvar:shared;
my @member:shared = ( 'toto:1.1.1.1:111', 'tata:2.2.2.2:222', 'titi:3.3.3.3:333') ;

my $nbThread = 5 ;
for ( 1..$nbThread ) { threads -> create ( \&job_to_parallelize ) ; }
foreach my $thr ( threads -> list() ) {
    $thr -> join();
}

sub job_to_parallelize {
    while (@member) {
        lock $lockvar;
        my $member = shift @member;
        my ($name,$ip,$port) = split(/:/, $member);
        {
            my %memberInfo:shared = ( ip => $ip, name => $name, port => $port );
            push(@allMember,\%memberInfo);
        }
    }
}

print Dumper(\@allMember);

输出 :

$VAR1 = [
          {
            'name' => 'toto',
            'port' => '111',
            'ip' => '1.1.1.1'
          },
          {
            'name' => 'tata',
            'port' => '222',
            'ip' => '2.2.2.2'
          },
          {
            'name' => 'titi',
            'port' => '333',
            'ip' => '3.3.3.3'
          }
        ];