Проблема с обратными галочками в многопоточном скрипте Perl в Windows

Question

У меня проблема со следующим очень простым и небольшим Perl-скриптом на платформе Windows.

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:\>

Проблема возникает, когда я запускаю команду (неважно, какую команду) из функции потока через backtick для сбора ее вывода.

У меня очень ограниченный опыт работы с потоками в Perl и с Perl в Windows. Я всегда старался вообще не использовать потоки в Perl, но на этот раз я должен их использовать.

Мне не удалось найти ответ в perldoc и Google. Может кто-нибудь объяснить, что случилось с моим сценарием?

Заранее спасибо!

Answer 1

Я могу воссоздать эту проблему на моем WinXP с одинаковыми результатами. Однако, похоже, это влияет только на STDOUT.

Проблема не появляется, если я печатаю в файл, и не появляется, когда я использую STDERR, как предположил Дмитрий. Однако он появляется, если я пишу в 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. Если вы хотите «исправить» проблему, убедитесь, что эхо и печать покрыты заблокированными значениями. Перемещение } в thread_func ниже _print должно обеспечить чистую печать. I.e.:

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

Забавный способ убедиться в этом - заменить echo некоторой командой Windows, которая записывает в STDERR, и посмотреть, не конфликтует ли это с печатью в STDERR в perl.