Блог

У меня проблема со следующим очень простым и небольшим скриптом 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] Получена строка: '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:tmpthr2.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:>

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

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

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

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

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

Проблема не появляется, если я печатаю в файл, и она не появляется, когда я использую STDERR, как предложил Дмитрий. Однако это появляется, если я записываю в стандартный вывод и файл. Что является подсказкой.

Добавление другой переменной обратного указателя к печати приводит к появлению проблемы в двух местах, перед каждой конкатенацией.

Во время тестирования я решил, что chomp () недостаточно, поэтому я добавил

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

С этим интересным результатом:

 [Thread_6] Got string: 'Thread_4Gotstring1925'.
  

Что, по-видимому, подразумевает, что $str фактически содержит весь буфер печати из другого потока. Что, мягко говоря, странно.

Если только это…

Выполняются два потока в одно и то же время:

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

Вероятно, Print и echo используют один и тот же буфер стандартного вывода, и поэтому все это переходит в $str с результирующей печатью:

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

Короче говоря, проблема Windows. Если вы хотите «исправить» проблему, убедитесь, что echo и print оба покрыты заблокированными значениями. Перемещение } в thread_func вниз под _print должно обеспечить чистую печать. Т.е.:

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

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