Windows中多線程Perl腳本中的反引號問題

Question

我在Windows平臺上遇到以下非常簡單和小型的Perl腳本問題。

use strict; 
use warnings; 
use threads; 
use threads::shared; 

my $print_mut : shared; 
my $run_mut : shared; 
my $counter : shared; 

$counter = 30; 

############################################################### 

sub _print($) 
{ 
lock($print_mut); 
my $str = shift; 
my $id = threads->tid(); 
print "[Thread_$id] $str"; 
return; 
} 

############################################################### 

sub _get_number() 
{ 
lock($counter); 
return $counter--; 
} 

############################################################### 

sub _get_cmd($) 
{ 
my $i = shift; 
if ($^O eq 'MSWin32') 
    { 
    return qq{cmd /c "echo $i"}; 
    } 
return "echo $i"; 
} 

############################################################### 

sub thread_func() 
{ 
while ((my $i = _get_number()) > 0) 
    { 
    my $str = 'NONE'; 
    { 
    lock($run_mut); 
    my $cmd = _get_cmd($i); 
    $str = `$cmd`; 
    } 
    chomp $str; 
    _print "Got string: '$str'.\n"; 
    } 
return; 
} 

############################################################### 

# Start all threads 
my @threads; 
for (1 .. 8) 
    { 
my $thr = threads->create('thread_func'); 
push @threads, $thr; 
    } 

# Wait for completion of the threads 
foreach (@threads) 
    { 
$_->join; 
    } 

############################################################### 

在我的Linux機器（Perl的v5.10.0）我得到正確的（預期的）結果：

 
$ perl ~/tmp/thr2.pl 
[Thread_1] Got string: '30'. 
[Thread_1] Got string: '29'. 
[Thread_2] Got string: '28'. 
[Thread_1] Got string: '27'. 
[Thread_2] Got string: '26'. 
[Thread_1] Got string: '25'. 
[Thread_1] Got string: '23'. 
[Thread_2] Got string: '24'. 
[Thread_2] Got string: '20'. 
[Thread_2] Got string: '19'. 
[Thread_1] Got string: '22'. 
[Thread_4] Got string: '18'. 
[Thread_5] Got string: '15'. 
[Thread_2] Got string: '17'. 
[Thread_2] Got string: '12'. 
[Thread_3] Got string: '21'. 
[Thread_4] Got string: '14'. 
[Thread_4] Got string: '7'. 
[Thread_1] Got string: '16'. 
[Thread_6] Got string: '11'. 
[Thread_2] Got string: '10'. 
[Thread_2] Got string: '2'. 
[Thread_3] Got string: '8'. 
[Thread_5] Got string: '13'. 
[Thread_8] Got string: '6'. 
[Thread_4] Got string: '5'. 
[Thread_1] Got string: '4'. 
[Thread_6] Got string: '3'. 
[Thread_7] Got string: '9'. 
[Thread_2] Got string: '1'. 
$ 

然而，在Windows（Perl的v5.10.1）我得到一個爛攤子：

 
C:\>perl Z:\tmp\thr2.pl 
[Thread_1] Got string: '30'. 
[Thread_2] Got string: '29'. 
[Thread_2] Got string: '21'. 
[Thread_6] Got string: '26'. 
[Thread_5] Got string: '25'. 
[Thread_5] Got string: '17'. 
[Thread_8] Got string: '23'. 
[Thread_1] Got string: '22'. 
[Thread_1] Got string: '14'. 
[Thread_2] Got string: '20'. 
[Thread_6] Got string: '18'. 
[Thread_7] Got string: '24'. 
[Thread_7] Got string: '9'. 
[Thread_8] Got string: '15'. 
[Thread_3] Got string: '28'. 
[Thread_3] Got string: '6'. 
[Thread_4] Got string: '12'. 
[Thread_2] Got string: '[Thread_4] Got string: '27'. 
19'. 
[Thread_6] Got string: '10'. 
[Thread_5] Got string: '16'. 
[Thread_7] Got string: '8'. 
[Thread_8] Got string: '7'. 
[Thread_1] Got string: '13'. 
[Thread_3] Got string: '5'. 
[Thread_4] Got string: '4'. 
[Thread_2] Got string: '11'. 
[Thread_6] Got string: '[Thread_2] Got string: '3'. 
[Thread_5] Got string: '2'. 
1'. 

C:\> 

當我通過反引號從線程函數運行一個命令（無所謂命令）來收集它的輸出時，問題就會發生。

我對Perl中的線程和Windows上的Perl的使用經驗非常有限。 我總是儘量避免在Perl中使用線程，但是這次我必須使用它們。

我無法在perldoc和Google中找到答案。 有人能解釋我的腳本有什麼問題嗎？

在此先感謝！

Answer 1

我可以在我的WinXP上重新創建這個問題，結果相同。但是，它似乎隻影響STDOUT。

如果我打印到文件中，則不會出現該問題，也不會在使用STDERR時出現，就像Dmitry建議的那樣。但是，如果我寫入STDOUT和一個文件，它會出現。這是一個線索。

向打印添加另一個反引號變量會導致問題出現在兩個位置，每個連接之前。

測試時，我決定，格格（）是不夠的，所以我加了

$str =~ s/[^\w]+//g; 

有了這個有趣的結果：

[Thread_6] Got string: 'Thread_4Gotstring1925'. 

然後似乎暗示$str其實包含整個從另一個線程打印緩衝區。至少可以說，這很奇怪。

除非這個...

兩個線程運行，以非常精確的同一時間：

print "[Thread_4] Got string: '19'.\n" 
$str = `echo 25` 

打印和回聲可能共享同一個STDOUT緩衝區，所以所有的它進入$str，結果打印：

chomp "[Thread_4] Got string: '19'.\n25\n" 
print "[Thread_6] Got string: [Thread_4] Got string: ''19'\n25'.\n" 

總之，一個windows問題。如果您想「修復」問題，請確保回顯和打印都被鎖定值覆蓋。將}的thread_func降至_print以下應提供乾淨的打印。即：

{ 
    lock($run_mut); 
    my $cmd = _get_cmd($i); 
    $str = `$cmd`; 
    chomp $str; 
    _print "Got string: '$str'.\n"; 
} 

一種有趣的方式來驗證這將是取代回聲與寫入STDERR一些窗口的命令，看是否與Perl中打印到STDERR相撞。