Perl - Capture: Tiny и темы - PullRequest
       2

Perl - Capture: Tiny и темы

1 голос
/ 14 октября 2019

Я экспериментирую с различными способами получения стандартного вывода / ошибок от дочернего процесса. Мое текущее решение использует open3. В большинстве случаев это работает, но в некоторых случаях вызывает тупик, особенно часто по какой-то причине это происходит в Windows. Я пытаюсь заменить его на Capture :: Tiny. Кажется, что это не проблема тупика, но есть другая проблема. Это не работает с потоками. И мне нужно запустить дочерние процессы из потоков. Вывод из основного потока перенаправляется и объединяется с выводом дочернего процесса, запущенного из другого потока. Документация гласит:

Файловые дескрипторы являются глобальными. Смешивание операций ввода-вывода и захватов в разных потоках без координации приведет к проблемам.

Я не смог найти какие-либо подробности об этой «координации». Возможно, кто-нибудь мог бы объяснить, какую координацию здесь можно применить? Ниже приведен упрощенный пример, демонстрирующий проблему:

##### test.pl
use strict;
use warnings;
use threads;
use Capture::Tiny qw(:all);
use Data::Dumper;

sub RunCmd
{
    my ($cmdArr) = @_;
    my $exe = shift @$cmdArr;
    my $tid = threads->tid();
    open my $outFh, "+>out_$tid.tmp" or die "Cannot open tmp out: $!";
    open my $errFh, "+>err_$tid.tmp" or die "Cannot open tmp err: $!";
    my ($out, $err, $exitCode) = capture { system($exe, @$cmdArr); } stdout => $outFh, stderr => $errFh;
    close $outFh;
    close $errFh;
    $exitCode = $exitCode >> 8;
    return ($exitCode == 0 ? 1 : 0, [ split(/(?<=\n)/, $out) ], [ split(/(?<=\n)/, $err) ], $exitCode);
}

sub StartJob
{
    my ($job) = @_;
    my($ret, $out, $err, $exitCode) = RunCmd($job->{'cmd'});
    $job->{'ret'} = $ret;
    $job->{'out'} = $out;
    $job->{'err'} = $err;
    $job->{'exitCode'} = $exitCode;
    return $job;
}

sub Execute
{
    my ($cmdList) = @_;
    my @threads = ();
    foreach (@$cmdList)
    {
        my $job = { 'cmd' => $_ };
        my $t = threads->new(sub { return StartJob($job) });
        push @threads, $t;
    }
    my @output = ();
    foreach my $t (@threads)
    {
        my $result = $t->join();
        push @output, $result;
    }
    return \@output;
}

my $commands = [
    [ $^X, 'myScript.pl', 'command1' ],
    [ $^X, 'myScript.pl', 'command2' ]
];

my $output = Execute($commands);
print Dumper($output);             # this output goes to out_1.tmp file
##### end of test.pl


##### myScript.pl
use strict;
use warnings;

my $cmd = $ARGV[0] // 'UNDEF';
foreach (1..5)
{
    sleep 1;
    print "$cmd: $_\n";
}

$cmd eq 'command2' and print STDERR "Error in $cmd\n"; 
##### end of myScript.pl
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...