1

我在 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] 得到字符串：'30'。
[Thread_1] 得到字符串：'29'。
[Thread_2] 得到字符串：'28'。
[Thread_1] 得到字符串：'27'。
[Thread_2] 得到字符串：'26'。
[Thread_1] 得到字符串：'25'。
[Thread_1] 得到字符串：'23'。
[Thread_2] 得到字符串：'24'。
[Thread_2] 得到字符串：'20'。
[Thread_2] 得到字符串：'19'。
[Thread_1] 得到字符串：'22'。
[Thread_4] 得到字符串：'18'。
[Thread_5] 得到字符串：'15'。
[Thread_2] 得到字符串：'17'。
[Thread_2] 得到字符串：'12'。
[Thread_3] 得到字符串：'21'。
[Thread_4] 得到字符串：'14'。
[Thread_4] 得到字符串：'7'。
[Thread_1] 得到字符串：'16'。
[Thread_6] 得到字符串：'11'。
[Thread_2] 得到字符串：'10'。
[Thread_2] 得到字符串：'2'。
[Thread_3] 得到字符串：'8'。
[Thread_5] 得到字符串：'13'。
[Thread_8] 得到字符串：'6'。
[Thread_4] 得到字符串：'5'。
[Thread_1] 得到字符串：'4'。
[Thread_6] 得到字符串：'3'。
[Thread_7] 得到字符串：'9'。
[Thread_2] 得到字符串：'1'。
$

但是，在 Windows (Perl v5.10.1) 上，我搞砸了：

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

C:\>

当我通过反引号从线程函数运行命令（无论是什么命令）以收集它的输出时，就会出现问题。

我对 Perl 中的线程和 Windows 上的 Perl 的经验非常有限。我总是尽量避免在 Perl 中使用线程，但这次我必须使用它们。

我没能在 perldoc 和 Google 中找到答案。有人可以解释我的脚本有什么问题吗？

提前致谢！

4

1 回答 1

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`

Print 和 echo 可能共享相同的 STDOUT 缓冲区，因此所有这些都进入$str，并生成打印结果：

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

简而言之，一个windows问题。如果您想“修复”问题，请确保 echo 和 print 都被锁定值覆盖。将其}向下thread_func移动_print应提供干净的打印。IE：

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

验证这一点的一种有趣方法是将 echo 替换为一些写入 STDERR 的 windows 命令，并查看这是否与 perl 中的 STDERR 打印冲突。

于 2011-04-30T08:56:14.493 回答