Perl - 創建一個新數組並將其傳遞給一個子例程線程

Question

我想創建一個特定長度的新多維數組（5，用於測試），用值填充它，然後將該數組傳遞給子例程它在與主代碼分離的線程中運行，以便主代碼可以繼續爲要填充的下一個值創建新數組。這個循環必須不斷進行下去。

我看到數組已通過，我可以看到$set[0]的值，但好像數組被覆蓋或其他東西。我不確定這裏發生了什麼。並且不能正確地傳遞可超連接對象：我必須在每個線程中創建一個新的連接對象。我在這裏錯過了什麼？

#!/usr/bin/perl -w -I /opt/hypertable/0.9.7.3/lib/perl -I /opt/hypertable/0.9.7.3/lib/perl/gen-perl 
use strict; 
use IO::Socket; 
use Geo::IP; 
use threads qw(stringify); 
use Net::NBName; 
use Data::Dumper; 
use Hypertable::ThriftClient; 

my $hypertable = new Hypertable::ThriftClient("Server", 38080); 
my $namespace = $hypertable->namespace_open("TEST"); 
my $MAXLEN  = 1524; 
my $buf  = ''; 

my $limit = 5; #length of array 
my $sock = IO::Socket::INET->new(LocalPort => '514', Proto => 'udp') || die("Socket: $@"); 

do { 
    my $count = 0; 
    my @set; 

    for ($count = 0; $count <= $limit; $count++) { 
     $sock->recv($buf, $MAXLEN); 
     my ($port, $ipaddr) = sockaddr_in($sock->peername); 
     my $hn = gethostbyaddr($ipaddr, AF_INET); 
     $buf =~ /<(\d+)>(.*?):(.*)/; 
     my $msg = $3; 
     $set[$count][0] = $hn; 
     $set[$count][1] = $msg; 
     print $count. " --> " 
      . $set[$count][0] . " --> " 
      . $set[$count][1] 
      . "\n"; #Multi dimensional array 

    } 

    my $thr = threads->create('logsys', @set, $hypertable); 

} while (1); 


sub logsys { 

    my $count = 0; 

    for ($count = 0; $count <= $limit; $count++) { 
     my $hypertable = shift; # Here I want to use the single NoSQL db connector object for all threads 
     my @set = shift; 

     print $count. " --> " 
      . @set->[$count][0] . " --> " 
      . @set->[$count][1] 
      . "\n"; # Here I expect the same exact array elements 

     #DO SOME MORE STUFF here 
    } 
} 

編輯：一個簡單的代碼要麼在螺紋或無螺紋運行。在線程中運行時，處理不會處理數組中的所有元素。但是，當沒有線程運行時，它會處理所有元素。

#!/usr/bin/perl -w -I /opt/hypertable/0.9.7.3/lib/perl -I /opt/hypertable/0.9.7.3/lib/perl/gen-perl 
use strict; 
use IO::Socket; 
use Geo::IP; 
use threads qw(stringify); 
use Net::NBName; 
use Data::Dumper; 
use Hypertable::ThriftClient; 

# Syslog Variables and Constants 
my $MAXLEN = 1524; 
my $limit = 5; #for testing 
my $sock; 
# Start Listening on UDP port 514 
$sock = IO::Socket::INET->new(LocalPort => '514', Proto => 'udp') || die("Socket: $@"); 

my $buf = ''; 
    my $count = 0; 
    my @set; 

    for ($count = 0; $count <= $limit; $count++) { 
    $sock->recv($buf, $MAXLEN); 
    my ($port, $ipaddr) = sockaddr_in($sock->peername); 
    my $hn = gethostbyaddr($ipaddr, AF_INET); 
    $buf=~/<(\d+)>(.*?):(.*)/; 
    my $msg=$3; 
    $set[$count][0] = $hn; 
    $set[$count][1] = $msg; 
print $count." --> ".$set[$count][0]." --> ".$set[$count][1]."\n";#Print original array, should print 5 elements 

    my $thr = threads->create('logsys',@set); 

#&logsys(@set); 

sub logsys { 
my $count = 0; 
my @set= @_; 

print "--------------------- ".scalar (@set)." -------------------\n"; 

for ($count=0; $count <= $limit; $count++) { 
print $count." --> ".$set[$count][0]." --> ".$set[$count][1]."\n";#print passed array, should same exact 5 elements 
if (open(WW,">syslog")){print WW $count." --> ".$set[$count][0]." --> ".$set[$count][1]."\n"; close(WW);} 

} 
} 

O/P的時候作爲線程運行：

0 --> ids-01p --> 23:48 IDS01 SFIMS: [FLIDS][Enterprise][138:4:1] sensitive_data: sensitive data - U.S. social security numbers without dashes [Classification: Sensitive Data] [Priority: 2] {TCP} 10.10.97.42:3065 -> 33.87.66.38:80 
1 --> ids-01p --> 23:50 IDS01 SFIMS: [FLIDS][Enterprise][138:4:1] sensitive_data: sensitive data - U.S. social security numbers without dashes [Classification: Sensitive Data] [Priority: 2] {TCP} 10.10.1.254:26616 -> 78.67.61.202:80 
2 --> ids-01p --> 23:50 IDS01 SFIMS: [FLIDS][Enterprise][138:4:1] sensitive_data: sensitive data - U.S. social security numbers without dashes [Classification: Sensitive Data] [Priority: 2] {TCP} 10.10.1.254:39180 -> 56.164.27.51:80 
3 --> ids-01p --> 23:51 IDS01 SFIMS: [FLIDS][Enterprise][138:4:1] sensitive_data: sensitive data - U.S. social security numbers without dashes [Classification: Sensitive Data] [Priority: 2] {TCP} 10.10.52.97:53967 -> 173.194.37.97:80 
4 --> ids-01p --> 23:51 IDS01 SFIMS: [FLIDS][Enterprise][119:15:1] http_inspect: OVERSIZE REQUEST-URI DIRECTORY [Classification: Potentially Bad Traffic] [Priority: 2] {TCP} 10.190.1.254:57265 -> 34.44.17.21:80 
5 --> ids-01p --> 23:51 IDS01 SFIMS: [FLIDS][Enterprise][119:15:1] http_inspect: OVERSIZE REQUEST-URI DIRECTORY [Classification: Potentially Bad Traffic] [Priority: 2] {TCP} 10.190.1.254:41960 -> 34.44.17.29:80 
--------------------- 6 ------------------- 
0 --> ids-01p --> 23:48 IDS01 SFIMS: [FLIDS][Enterprise][138:4:1] sensitive_data: sensitive data - U.S. social security numbers without dashes [Classification: Sensitive Data] [Priority: 2] {TCP} 10.190.97.42:3065 -> 43.87.66.38:80 
Perl exited with active threads: 
     1 running and unjoined 
     0 finished and unjoined 
     0 running and detached 
1 --> ids-01p --> 23:50 IDS01 SFIMS: [FLIDS][Enterprise][138:4:1] sensitive_data: sensitive data - U.S. social security numbers without dashes [Classification: Sensitive Data] [Priority: 2] {TCP} 10.190.1.254:26616 -> 43.67.61.202:80 

時，因爲沒有一個線程運行O/P：

0 --> ids-01p --> 36:48 IDS01 SFIMS: [FLIDS][Enterprise][138:4:1] sensitive_data: sensitive data - U.S. social security numbers without dashes [Classification: Sensitive Data] [Priority: 2] {TCP} 10.10.1.254:34053 -> 69.164.26.77:80 
1 --> ids-01p --> 36:50 IDS01 SFIMS: [FLIDS][Enterprise][138:4:1] sensitive_data: sensitive data - U.S. social security numbers without dashes [Classification: Sensitive Data] [Priority: 2] {TCP} 10.1.65.51:57977 -> 216.137.41.5:80 
2 --> ids-01p --> 36:53 IDS01 SFIMS: [FLIDS][Enterprise][128:4:1] ssh: Protocol mismatch [Classification: Detection of a Non-Standard Protocol or Event] [Priority: 2] {TCP} 10.10.241.46:11120 -> 10.10.125.227:22 
3 --> ids-01p --> 36:54 IDS01 SFIMS: [FLIDS][Enterprise][128:4:1] ssh: Protocol mismatch [Classification: Detection of a Non-Standard Protocol or Event] [Priority: 2] {TCP} 10.10.241.46:11122 -> 10.1.125.225:22 
4 --> ids-01p --> 36:54 IDS01 SFIMS: [FLIDS][Enterprise][138:4:1] sensitive_data: sensitive data - U.S. social security numbers without dashes [Classification: Sensitive Data] [Priority: 2] {TCP} 10.1.118.96:61686 -> 50.19.254.195:80 
5 --> ids-01p --> 36:54 IDS01 SFIMS: [FLIDS][Enterprise][138:4:1] sensitive_data: sensitive data - U.S. social security numbers without dashes [Classification: Sensitive Data] [Priority: 2] {TCP} 10.1.1.254:29437 -> 184.73.178.248:80 
--------------------- 7 ------------------- 
0 --> ids-01p --> 36:48 IDS01 SFIMS: [FLIDS][Enterprise][138:4:1] sensitive_data: sensitive data - U.S. social security numbers without dashes [Classification: Sensitive Data] [Priority: 2] {TCP} 10.10.1.254:34053 -> 69.164.26.77:80 
1 --> ids-01p --> 36:50 IDS01 SFIMS: [FLIDS][Enterprise][138:4:1] sensitive_data: sensitive data - U.S. social security numbers without dashes [Classification: Sensitive Data] [Priority: 2] {TCP} 10.1.65.51:57977 -> 216.137.41.5:80 
2 --> ids-01p --> 36:53 IDS01 SFIMS: [FLIDS][Enterprise][128:4:1] ssh: Protocol mismatch [Classification: Detection of a Non-Standard Protocol or Event] [Priority: 2] {TCP} 10.10.241.46:11120 -> 10.10.125.227:22 
3 --> ids-01p --> 36:54 IDS01 SFIMS: [FLIDS][Enterprise][128:4:1] ssh: Protocol mismatch [Classification: Detection of a Non-Standard Protocol or Event] [Priority: 2] {TCP} 10.10.241.46:11122 -> 10.1.125.225:22 
4 --> ids-01p --> 36:54 IDS01 SFIMS: [FLIDS][Enterprise][138:4:1] sensitive_data: sensitive data - U.S. social security numbers without dashes [Classification: Sensitive Data] [Priority: 2] {TCP} 10.1.118.96:61686 -> 50.19.254.195:80 
5 --> ids-01p --> 36:54 IDS01 SFIMS: [FLIDS][Enterprise][138:4:1] sensitive_data: sensitive data - U.S. social security numbers without dashes [Classification: Sensitive Data] [Priority: 2] {TCP} 10.1.1.254:29437 -> 184.73.178.248:80 

Answer 1

一件事，你是使用參數(..., @set, $hypertable)調用線程構造函數，但是在使用shift的線程中爲其分配值$hypertable，然後再指定@set。你要麼需要改變的參數的順序，如

threads->create('logsys',$hypertable,@set); 

或使用pop從的shift@_而不是（這從一開始就刪除它），最後刪除的說法：

my $hypertable = pop; # same as pop(@_) 

其次，諸如@set = shift這樣的任務幾乎總是錯誤的。將一個標量值的返回值shift分配給列表是不常見的。一旦你的線程分配$hypertable和@_取出它的價值，這一切仍然在@_爲您提供的@set，所以你可以說

my @set = @_; 

---

@set->[...]也沒有在Perl意義。要在線程訪問二維數組@set的元素，你可以使用相同的符號用於創建數組：

print $count." --> ".$set[$count][0]." --> ".$set[$count][1]."\n"; 

Answer 2

人們抱怨線程是緩慢的，但是當他們使用不當，這只是例如當產生大量線程而不是使用工作線程時。

下面是你可以在你的代碼解決這個問題：

use threads; 
use Thread::Queue::Any 1.03 qw(); 

sub logsys {      # Gets a reference, so uses 
    my ($hypertable, $set) = @_; # @$set and $set->[...] 
    ... $set->[...][...] ...  # instead of 
}         # @set and $set[...] 

my $db_queue = Thread::Queue::Any->new(); 

my $db_thread = async { 
    my $hypertable = ...; # Only executed once. 
    while (my $set = $db_queue->dequeue()) { 
     logsys($hypertable, $set); 
    } 
}; 

... $db_queue->enqueue(\@set); ... 

$db_queue->enqueue(undef); # Signal that we're done. 
$db_thread->join();   # Wait for db to be done. 

由於只需一個DB線程，它也解決了你不可能渴望擁有的所有線程單一的數據庫連接。