IPC::Open3 を使って、子プロセスの標準出力と標準エラー出力をポーリングする。(Windows でも動くよ!)
先日の
IPC::Open3 を使って、子プロセスの標準出力と標準エラー出力をポーリングする。(Windows では動かなかった…) - ◆F99a.q8oVEの日記
は Windows では動きませんでした。
Windows のルートでは
# $dad_wtr は open3 の第2引数 # open3(undef, '>&'. fileno($child_out), '>&' . fileno($child_err), @cmd) # を実行したとすると '>&'. fileno($child_out) $dad_wtr =~ s/^[<>]&// $kid_rdr = \*{$dad_wtr};
されたものが fdopen に渡されています。
ここで、上の例のように fd を渡してもうまくいきませんでした。
そこで、
open3(undef, '>&'. $child_out, '>&' . $child_err, @cmd);
こうして見てもうまくいかないので…
色々試して↓ならうまくいきました。"*" できるもの、つまりグロブを指定しないといけないということかな?
open3(undef, '>&CHILD_OUT', '>&CHILD_ERR', @cmd);
ということで、完成版。
qx2 は Windows 以外、qx2_win は Windows 用。Windows では WIFEXITED が定義されていないと思うので、適宜あれしてください。
#!/usr/bin/env perl use strict; use warnings; sub qx2_win { my @cmd = @_; use IPC::Open3; use File::Temp qw/tmpnam/; my $out_file = tmpnam(); my $err_file = tmpnam(); local (*CHILD_OUT, *CHILD_ERR); open CHILD_OUT, '+>', $out_file or die $!; open CHILD_ERR, '+>', $err_file or die $!; my $pid = open3(undef, '>&CHILD_OUT', '>&CHILD_ERR', @cmd); waitpid $pid, 0; # my $code = WIFEXITED($?) ? WEXITSTATUS($?) : WTERMSIG($?); my $code = ($? | 0xFF) ? ($? >> 8) & 0xFF : $?; seek CHILD_OUT, 0, 0; seek CHILD_ERR, 0, 0; my $out = do { local $/; <CHILD_OUT>; }; my $err = do { local $/; <CHILD_ERR>; }; close CHILD_OUT; close CHILD_ERR; unlink $out_file, $err_file; return ($out, $err, $code); } sub qx2 { my @cmd = @_; use IPC::Open3; use Symbol qw/gensym/; use IO::Select; use POSIX ":sys_wait_h"; my ($child_out, $child_err) = (gensym, gensym); my $pid = open3(undef, $child_out, $child_err, @cmd); my $s = new IO::Select($child_out, $child_err); my $out = my $err = ''; while (1) { while (my @ready = $s->can_read) { for my $fh (@ready) { if (sysread($fh, my $buf, 4096) > 0) { if ($fh == $child_out) { $out .= $buf; } elsif ($fh == $child_err) { $err .= $buf; } } else { $s->remove($fh); close $fh; } } } if (waitpid($pid, WNOHANG) > 0) { last; } } my $code = WIFEXITED($?) ? WEXITSTATUS($?) : WTERMSIG($?); return ($out, $err, $code); } use Test::More; my @tests = ( { command => [ 'perl', '-e', q{print 'a'} ], out => 'a', err => '', code => 0 }, { command => [ 'perl', '-e', q{exit 0} ], out => '', err => '', code => 0 }, { command => [ 'perl', '-e', q{exit 1} ], out => '', err => '', code => 1 }, { command => [ 'perl', '-e', q{exit 255} ], out => '', err => '', code => 255 }, { command => [ 'perl', '-e', q{print 'a' x (1024 ** 2)} ], out => 'a' x (1024 ** 2), err => '', code => 0 }, { command => [ 'perl', '-e', q{print STDERR 'a' x (1024 ** 2)} ], out => '', err => 'a' x (1024 ** 2), code => 0 }, { command => [ 'perl', '-e', q{print STDERR 'b' x (1024 ** 2); sleep 3; print 'a' x (1024 ** 2)} ], out => 'a' x (1024 ** 2), err => 'b' x (1024 ** 2), code => 0 }, ); for my $func (\&qx2, \&qx2_win) { for my $test (@tests) { my ($out, $err, $code) = &$func(@{$test->{command}}); is $out, $test->{out}; is $err, $test->{err}; is $code, $test->{code}; } } done_testing;