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和文件，它会出现。这是一个线索。

在打印中添加另一个反引号变量会导致问题在每个连接之前出现在两个位置。

在测试时，我认为chomp（）不足，所以我添加了

$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的Windows命令替换echo，并查看它是否与perl中的STDERR打印冲突。

Windows上的多线程Perl脚本中的反引号问题

1 个答案: