Problem with backticks in multi-threaded Perl script on Windows

问题

I have a trouble with the following very simple and small Perl script on Windows platform.

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;
  }

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

On my Linux box (Perl v5.10.0) I get correct (expected) results:

$ 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'.
$

However, on Windows (Perl v5.10.1) I get a mess:

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

The problem happens when I run a command (doesn't matter what command) from the thread function via backtick to collect it's output.

I have very limited experience with threads in Perl and with Perl on Windows. I always tried to avoid using threads in Perl at all, but this time I have to use them.

I didn't manage to find the answer in perldoc and Google. Could someone please explain what's wrong with my script?

Thanks in advance!

回答1:

I can recreate this problem on my WinXP, with identical results. However, it seems to only affect STDOUT.

The problem does not appear if I print to a file, nor does it appear when I use STDERR, like Dmitry suggested. It does however appear if I write to STDOUT and a file. Which is a clue.

Adding another backtick variable to the print causes the problem to appear in two places, before each concatenation.

While testing, I decided that chomp() was insufficient, so I added

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

With this interesting result:

[Thread_6] Got string: 'Thread_4Gotstring1925'.

Which then seems to imply that $str in fact holds the entire print buffer from another thread. Which is odd, to say the least.

Unless this...

Two threads run, at the very exact same time:

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

Print and echo probably share the same STDOUT buffer, and so all of it goes into $str, with the resulting print:

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

In short, a windows problem. If you want to "fix" the problem, make sure echo and print are both covered by locked values. Moving the } in thread_func down below the _print should provide a clean print. I.e.:

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

A funny way to verify this would be to replace echo with some windows command that writes to STDERR, and see if that clashes with a print to STDERR within perl.

来源：https://stackoverflow.com/questions/5831526/problem-with-backticks-in-multi-threaded-perl-script-on-windows

标签

windows

multithreading

perl

backticks