Skip Menu |
 

This queue is for tickets about the IO-Async CPAN distribution.

Report information
The Basics
Id: 129225
Status: patched
Priority: 0/
Queue: IO-Async

People
Owner: Nobody in particular
Requestors: leonerd-cpan [...] leonerd.org.uk
Cc:
AdminCc:

Bug Information
Severity: Wishlist
Broken in: (no value)
Fixed in: (no value)



Subject: Add a $loop->run_process
Download (untitled) / with headers
text/plain 1.1k
We have the old-and-annoying ->run_child which doesn't play nicely with Futures. It'd be nice to have a Future-returning oneliner to replace many common uses of system(), qx(), IPC::Run, etc. my ($exitcode, $stdout) = $loop->run_process(command => ["ls", "-l"])->get; feels like a nice start. Except, how would we distinguish the "I want to capture STDOUT" of a qx()-alike from the "leave STDOUT pointing at my terminal" of a system()-alike? And what if we wanted to capture STDERR as well? In either case we can pass in some STDIN data as extra args so that's not too difficult to add. Perhaps there'd be some extra named arguments, possibly with some named method shortcuts for invoking them: $loop->run_process_stdout( ... ) == $loop->run_process( capture_stdout => 1, ... ); and so on? In either case: they'd return a Future that directly represents the eventual result of running the process. If the caller wants to additionally do Weird Things perhaps grabbing the PID as it starts, or interact directly with the underlying IaProcess object, they can pass in maybe an `on_process` callback to see those. Or maybe they have to use ->spawn_process + await a finish future themself. -- Paul Evans
RT-Send-CC: leonerd-cpan [...] leonerd.org.uk
Download (untitled) / with headers
text/plain 287b
Hi, Paul! I've done a small patch to implement this shortcut. I hope it will be helpful. Also, I didn't find information about what is the best way to contribute to the project? Is it fine to put patch files here? Is there a GitHub or any other public repository for this project?
Sorry, I forgot to attach files.
Subject: 39loop-runproccess.pl
#!/usr/bin/perl use strict; use warnings; use IO::Async::Test; use Test::More; use Test::Fatal; use IO::Async::Loop; use IO::Async::OS; use Data::Dumper; plan skip_all => "POSIX fork() is not available" unless IO::Async::OS->HAVE_POSIX_FORK; my $loop = IO::Async::Loop->new_builtin; testing_loop( $loop ); # Same testing as run_child to proof that nothing broken my ( $exitcode, $stdout, $stderr ); my $defaul_capture = [qw(exitcode stdout stderr)]; ( $exitcode, $stdout, $stderr ) = $loop->run_process( code => sub { 0 }, capture => $defaul_capture, )->get; ok( ($exitcode & 0x7f) == 0, 'WIFEXITED($exitcode) after sub { 0 }' ); is( ($exitcode >> 8), 0, 'WEXITSTATUS($exitcode) after sub { 0 }' ); is( $stdout, "", '$stdout after sub { 0 }' ); is( $stderr, "", '$stderr after sub { 0 }' ); ( $exitcode, $stdout, $stderr ) = $loop->run_process( code => sub { 3 }, capture => $defaul_capture, )->get; ok( ($exitcode & 0x7f) == 0, 'WIFEXITED($exitcode) after sub { 3 }' ); is( ($exitcode >> 8), 3, 'WEXITSTATUS($exitcode) after sub { 3 }' ); is( $stdout, "", '$stdout after sub { 3 }' ); is( $stderr, "", '$stderr after sub { 3 }' ); ( $exitcode, $stdout, $stderr ) = $loop->run_process( command => [ $^X, "-e", '1' ], capture => $defaul_capture, )->get; ok( ($exitcode & 0x7f) == 0, 'WIFEXITED($exitcode) after perl -e 1' ); is( ($exitcode >> 8), 0, 'WEXITSTATUS($exitcode) after perl -e 1' ); is( $stdout, "", '$stdout after perl -e 1' ); is( $stderr, "", '$stderr after perl -e 1' ); ( $exitcode, $stdout, $stderr ) = $loop->run_process( command => [ $^X, "-e", 'exit 5' ], capture => $defaul_capture, )->get; ok( ($exitcode & 0x7f) == 0, 'WIFEXITED($exitcode) after perl -e exit 5' ); is( ($exitcode >> 8), 5, 'WEXITSTATUS($exitcode) after perl -e exit 5' ); is( $stdout, "", '$stdout after perl -e exit 5' ); is( $stderr, "", '$stderr after perl -e exit 5' ); ( $exitcode, $stdout, $stderr ) = $loop->run_process( code => sub { print "hello\n"; 0 }, capture => $defaul_capture, )->get; ok( ($exitcode & 0x7f) == 0, 'WIFEXITED($exitcode) after sub { print }' ); is( ($exitcode >> 8), 0, 'WEXITSTATUS($exitcode) after sub { print }' ); is( $stdout, "hello\n", '$stdout after sub { print }' ); is( $stderr, "", '$stderr after sub { print }' ); ( $exitcode, $stdout, $stderr ) = $loop->run_process( command => [ $^X, "-e", 'print "goodbye\n"' ], capture => $defaul_capture, )->get; ok( ($exitcode & 0x7f) == 0, 'WIFEXITED($exitcode) after perl STDOUT' ); is( ($exitcode >> 8), 0, 'WEXITSTATUS($exitcode) after perl STDOUT' ); is( $stdout, "goodbye\n", '$stdout after perl STDOUT' ); is( $stderr, "", '$stderr after perl STDOUT' ); ( $exitcode, $stdout, $stderr ) = $loop->run_process( command => [ $^X, "-e", 'print STDOUT "output\n"; print STDERR "error\n";' ], capture => $defaul_capture, )->get; ok( ($exitcode & 0x7f) == 0, 'WIFEXITED($exitcode) after perl STDOUT/STDERR' ); is( ($exitcode >> 8), 0, 'WEXITSTATUS($exitcode) after perl STDOUT/STDERR' ); is( $stdout, "output\n", '$stdout after perl STDOUT/STDERR' ); is( $stderr, "error\n", '$stderr after perl STDOUT/STDERR' ); # perl -pe 1 behaves like cat; copies STDIN to STDOUT ( $exitcode, $stdout, $stderr ) = $loop->run_process( command => [ $^X, "-pe", '1' ], stdin => "some data\n", capture => $defaul_capture, )->get; ok( ($exitcode & 0x7f) == 0, 'WIFEXITED($exitcode) after perl STDIN->STDOUT' ); is( ($exitcode >> 8), 0, 'WEXITSTATUS($exitcode) after perl STDIN->STDOUT' ); is( $stdout, "some data\n", '$stdout after perl STDIN->STDOUT' ); is( $stderr, "", '$stderr after perl STDIN->STDOUT' ); # Testing what the future will return by default my ( $future, $proc_id, $pid ); $future = $loop->run_process( command => [ $^X, "-e", 'print STDOUT "output"; print STDERR "error";' ], ); ( $exitcode, $stdout ) = $future->get; ok( ($exitcode & 0x7f) == 0, 'Exit code is correct with default captures' ); is( ($exitcode >> 8), 0, 'Exit code is correct with default captures' ); is( $stdout, "output", 'STDOUT is correct with default captures' ); # Testing what the future will return with additional captures ( $future, $proc_id ) = $loop->run_process( command => [ $^X, "-e", 'print STDOUT "output"; print STDERR "error";' ], capture => [qw(pid exitcode stdout stderr)], ); ( $pid, $exitcode, $stdout, $stderr ) = $future->get; is( $proc_id, $pid, 'PID is correct with default captures' ); ok( ($exitcode & 0x7f) == 0, 'Exit code is correct with custom captures' ); is( ($exitcode >> 8), 0, 'Exit code is correct with custom captures' ); is( $stdout, "output", 'STDOUT is correct with custom captures' ); is( $stderr, "error", 'STDERR is correct with custom captures' ); ok( exception { $loop->run_process( command => [ $^X, "-e", 1 ], some_key_you_fail => 1 ) }, 'unrecognised key fails' ); # Testing what the future will return with additional captures in reverse order ( $future, $proc_id ) = $loop->run_process( command => [ $^X, "-e", 'print STDOUT "output"; print STDERR "error";' ], capture => [qw(stderr stdout exitcode pid)], ); ( $stderr, $stdout, $exitcode, $pid ) = $future->get; is( $proc_id, $pid, 'PID is correct with reversed captures' ); ok( ($exitcode & 0x7f) == 0, 'Exit code is correct with reversed captures' ); is( ($exitcode >> 8), 0, 'Exit code is correct with reversed captures' ); is( $stdout, "output", 'STDOUT is correct with reversed captures' ); is( $stderr, "error", 'STDERR is correct with reversed captures' ); # Testing error handling ok( exception { $loop->run_process( command => [ $^X, "-e", 1 ], some_key_you_fail => 1 ) }, 'unrecognised key fails' ); ok( exception { $loop->run_process( command => [ $^X, "-e", 1 ], capture => 'pid' ) }, 'Capture in invapid format' ); ok( exception { $loop->run_process( command => [ $^X, "-e", 1 ], capture => ['invalid_capture'] ) }, 'Invalid capture type' ); ok( exception { $loop->run_process( command => [ $^X, "-e", 1 ], on_finish => sub{ 0 } ) }, 'Failing when finish callback is passed' ); done_testing;
Subject: patch_lib_IO_Async_Loop.pm
1283a1284,1349 > > =head2 run_process > > $future = $loop->run_process( %params ) > > This creates a new child process to run the given code block or command, > capturing its STDOUT and STDERR streams. The method returns in scalar context > future or in list context - future and pid of the child proccess. When the process > exits, the future will be resolved. The Future will return C<exitcode> and > captured C<stdout> by default. > > The method is a wrapper around run_child. It can accept the same parameters as > run_child, except C<on_finish>. > > =over 8 > > =item capture => ARRAY > Optional, the list of value's names which should be returned by resolving future. > Values will be returned in the same order as you put them in the array. > It can contain next values: C<pid>, C<exitcode>, C<stdout>, C<stderr> > > =back > > This method is just a shortcut for run_child method. > > > my ($future, $pid) = $loop->run_process(command => "command here"); > > my ($exitcode, $stdout) = $future->get; > > Z<> > > my ($exitcode, $stdout) = $loop->run_process(command => "command here")->get(); > > =cut > > my @process_captures = qw(pid exitcode stdout stderr); > > sub run_process > { > my $self = shift; > my %params = @_; > > $params{on_finish} and croak "Unrecognised parameter on_finish"; > > my $capture = delete $params{capture} // [qw(exitcode stdout)]; > ref $capture eq ref [] or croak "Expected 'capture' to be an array reference"; > > for my $name ( @$capture ) { > grep { $_ eq $name } @process_captures or croak "Unexpected capture $name"; > } > > my $future = $self->new_future; > my $pid = $self->run_child( > %params, > on_finish => sub { > my %results; > @results{ @process_captures } = @_; > > $future->done( @results{ @$capture } ); > }, > ); > > return wantarray ? ( $future, $pid ) : $future; > } >
Download (untitled) / with headers
text/plain 158b
I reworked a little bit the first version and I did interface much like open_process/child. Now run_process returns in list context future and process object.
Subject: 39loop-runproccess.t
#!/usr/bin/perl use strict; use warnings; use IO::Async::Test; use Test::More; use Test::Fatal; use IO::Async::Loop; use IO::Async::OS; use Data::Dumper; plan skip_all => "POSIX fork() is not available" unless IO::Async::OS->HAVE_POSIX_FORK; my $loop = IO::Async::Loop->new_builtin; testing_loop( $loop ); # Same testing as run_child to proof that nothing broken my ( $exitcode, $stdout, $stderr ); my $defaul_capture = [qw(exitcode stdout stderr)]; ( $exitcode, $stdout, $stderr ) = $loop->run_process( code => sub { 0 }, capture => $defaul_capture, )->get; ok( ($exitcode & 0x7f) == 0, 'WIFEXITED($exitcode) after sub { 0 }' ); is( ($exitcode >> 8), 0, 'WEXITSTATUS($exitcode) after sub { 0 }' ); is( $stdout, "", '$stdout after sub { 0 }' ); is( $stderr, "", '$stderr after sub { 0 }' ); ( $exitcode, $stdout, $stderr ) = $loop->run_process( code => sub { 3 }, capture => $defaul_capture, )->get; ok( ($exitcode & 0x7f) == 0, 'WIFEXITED($exitcode) after sub { 3 }' ); is( ($exitcode >> 8), 3, 'WEXITSTATUS($exitcode) after sub { 3 }' ); is( $stdout, "", '$stdout after sub { 3 }' ); is( $stderr, "", '$stderr after sub { 3 }' ); ( $exitcode, $stdout, $stderr ) = $loop->run_process( command => [ $^X, "-e", '1' ], capture => $defaul_capture, )->get; ok( ($exitcode & 0x7f) == 0, 'WIFEXITED($exitcode) after perl -e 1' ); is( ($exitcode >> 8), 0, 'WEXITSTATUS($exitcode) after perl -e 1' ); is( $stdout, "", '$stdout after perl -e 1' ); is( $stderr, "", '$stderr after perl -e 1' ); ( $exitcode, $stdout, $stderr ) = $loop->run_process( command => [ $^X, "-e", 'exit 5' ], capture => $defaul_capture, )->get; ok( ($exitcode & 0x7f) == 0, 'WIFEXITED($exitcode) after perl -e exit 5' ); is( ($exitcode >> 8), 5, 'WEXITSTATUS($exitcode) after perl -e exit 5' ); is( $stdout, "", '$stdout after perl -e exit 5' ); is( $stderr, "", '$stderr after perl -e exit 5' ); ( $exitcode, $stdout, $stderr ) = $loop->run_process( code => sub { print "hello\n"; 0 }, capture => $defaul_capture, )->get; ok( ($exitcode & 0x7f) == 0, 'WIFEXITED($exitcode) after sub { print }' ); is( ($exitcode >> 8), 0, 'WEXITSTATUS($exitcode) after sub { print }' ); is( $stdout, "hello\n", '$stdout after sub { print }' ); is( $stderr, "", '$stderr after sub { print }' ); ( $exitcode, $stdout, $stderr ) = $loop->run_process( command => [ $^X, "-e", 'print "goodbye\n"' ], capture => $defaul_capture, )->get; ok( ($exitcode & 0x7f) == 0, 'WIFEXITED($exitcode) after perl STDOUT' ); is( ($exitcode >> 8), 0, 'WEXITSTATUS($exitcode) after perl STDOUT' ); is( $stdout, "goodbye\n", '$stdout after perl STDOUT' ); is( $stderr, "", '$stderr after perl STDOUT' ); ( $exitcode, $stdout, $stderr ) = $loop->run_process( command => [ $^X, "-e", 'print STDOUT "output\n"; print STDERR "error\n";' ], capture => $defaul_capture, )->get; ok( ($exitcode & 0x7f) == 0, 'WIFEXITED($exitcode) after perl STDOUT/STDERR' ); is( ($exitcode >> 8), 0, 'WEXITSTATUS($exitcode) after perl STDOUT/STDERR' ); is( $stdout, "output\n", '$stdout after perl STDOUT/STDERR' ); is( $stderr, "error\n", '$stderr after perl STDOUT/STDERR' ); # perl -pe 1 behaves like cat; copies STDIN to STDOUT ( $exitcode, $stdout, $stderr ) = $loop->run_process( command => [ $^X, "-pe", '1' ], stdin => "some data\n", capture => $defaul_capture, )->get; ok( ($exitcode & 0x7f) == 0, 'WIFEXITED($exitcode) after perl STDIN->STDOUT' ); is( ($exitcode >> 8), 0, 'WEXITSTATUS($exitcode) after perl STDIN->STDOUT' ); is( $stdout, "some data\n", '$stdout after perl STDIN->STDOUT' ); is( $stderr, "", '$stderr after perl STDIN->STDOUT' ); # Testing what the future will return by default my ( $future, $proc, $pid ); $future = $loop->run_process( command => [ $^X, "-e", 'print STDOUT "output"; print STDERR "error";' ], ); ( $exitcode, $stdout ) = $future->get; ok( ($exitcode & 0x7f) == 0, 'Exit code is correct with default captures' ); is( ($exitcode >> 8), 0, 'Exit code is correct with default captures' ); is( $stdout, "output", 'STDOUT is correct with default captures' ); # Testing what the future will return with additional captures ( $future, $proc ) = $loop->run_process( command => [ $^X, "-e", 'print STDOUT "output"; print STDERR "error";' ], capture => [qw(pid exitcode stdout stderr)], ); ( $pid, $exitcode, $stdout, $stderr ) = $future->get; my $expected = $proc->pid; is( $expected, $pid, 'PID is correct with default captures' ); ok( ($exitcode & 0x7f) == 0, 'Exit code is correct with custom captures' ); is( ($exitcode >> 8), 0, 'Exit code is correct with custom captures' ); is( $stdout, "output", 'STDOUT is correct with custom captures' ); is( $stderr, "error", 'STDERR is correct with custom captures' ); ok( exception { $loop->run_process( command => [ $^X, "-e", 1 ], some_key_you_fail => 1 ) }, 'unrecognised key fails' ); # Testing what the future will return with additional captures in reverse order ( $future, $proc ) = $loop->run_process( command => [ $^X, "-e", 'print STDOUT "output"; print STDERR "error";' ], capture => [qw(stderr stdout exitcode pid)], ); ( $stderr, $stdout, $exitcode, $pid ) = $future->get; is( $proc->pid, $pid, 'PID is correct with reversed captures' ); ok( ($exitcode & 0x7f) == 0, 'Exit code is correct with reversed captures' ); is( ($exitcode >> 8), 0, 'Exit code is correct with reversed captures' ); is( $stdout, "output", 'STDOUT is correct with reversed captures' ); is( $stderr, "error", 'STDERR is correct with reversed captures' ); # Testing error handling ok( exception { $loop->run_process( command => [ $^X, "-e", 1 ], some_key_you_fail => 1 ) }, 'unrecognised key fails' ); ok( exception { $loop->run_process( command => [ $^X, "-e", 1 ], capture => 'pid' ) }, 'Capture in invapid format' ); ok( exception { $loop->run_process( command => [ $^X, "-e", 1 ], capture => ['invalid_capture'] ) }, 'Invalid capture type' ); ok( exception { $loop->run_process( command => [ $^X, "-e", 1 ], on_finish => sub{ 0 } ) }, 'Failing when finish callback is passed' ); done_testing;
Subject: patch_lib_IO_Async_Loop_v2.pm
1242a1243 > my @process_captures = qw(pid exitcode stdout stderr); 1250a1252,1314 > $params{capture} = \@process_captures; > > my ( $future, $process ) = $self->run_process(%params); > > $future->on_ready(sub { $on_finish->($future->get); undef $future }); > > return $process->pid; > } > > > =head2 run_process > > $future = $loop->run_process( %params ) > > This creates a new child process to run the given code block or command, > capturing its STDOUT and STDERR streams. The method returns in scalar context > future or in list context - future and process object. When the process > exits, the future will be resolved. The Future will return C<exitcode> and > captured C<stdout> by default. > > =over 8 > > =item command => ARRAY or STRING > > =item code => CODE > > The command or code to run in the child process (as per the C<spawn_child> > method) > > > =item capture => ARRAY > Optional, the list of value's names which should be returned by resolving future. > Values will be returned in the same order as you put them in the array. > It can contain next values: C<pid>, C<exitcode>, C<stdout>, C<stderr> > > =item stdin => STRING > > Optional. String to pass in to the child process's STDIN stream. > > =item setup => ARRAY > > Optional reference to an array to pass to the underlying C<spawn> method. > > =back > > This method is just a shortcut for run_child method. > > > my ($future, $pid) = $loop->run_process(command => "command here"); > > my ($exitcode, $stdout) = $future->get; > > Z<> > > my ($exitcode, $stdout) = $loop->run_process(command => "command here")->get(); > > =cut > > sub run_process > { > my $self = shift; > my %params = @_; > 1264a1329,1336 > > my $capture = delete $params{capture} // [qw(exitcode stdout)]; > ref $capture eq ref [] or croak "Expected 'capture' to be an array reference"; > > for my $name ( @$capture ) { > grep { $_ eq $name } @process_captures or croak "Unexpected capture $name"; > } > 1267,1268c1339,1341 < require IO::Async::Process; < my $process = IO::Async::Process->new( --- > my $future = $self->new_future; > > my $process = $self->open_process( 1274,1275c1347,1351 < my ( $process, $exitcode ) = @_; < $on_finish->( $process->pid, $exitcode, $stdout, $stderr ); --- > my ( $proc, $exitcode ) = @_; > my %results; > @results{ @process_captures } = ( $proc->pid, $exitcode, $stdout, $stderr ); > > $future->done( @results{ @$capture } ); 1281c1357 < return $process->pid; --- > return wantarray ? ( $future, $process ) : $future;
Download (untitled) / with headers
text/plain 275b
Hi, Sorry I've not got around to giving a proper review/reply of this yet. Been quite busy with some non-perl things of late. I'll try to make some time either tomorrow or at the weekend though, as this is definitely the sort of thing I'd like to get added. -- Paul Evans
Download (untitled) / with headers
text/plain 724b
Hi, Having had a look over this, two things come to mind: 1) The patch isn't in unified diff form, the result you'd get from `diff -u` - can you resend it in that format? 2) I don't think the method ought to be sensitive to `wantarray` and yield a two-element result in list context, because it would confuse such code as: Future->wait_any( $loop->timeout_future( after => 10 ), $loop->run_process( ... ), ) Thinking further, I can't see many situations where you'd even need the PID anyhow, so maybe best not to provide that for now. If later a use-case emerges then perhaps a new method with a new name to return that as a two-element list, and this one can become a small wrapper for it. -- Paul Evans
Download (untitled) / with headers
text/plain 629b
Attached patch makes an initial attempt at this. I started with your given code and tests from the first patch, and adjusted it somewhat. This adds a method $f = $loop->run_process(...) which doesn't have the option to return the PID, nor does it allow capturing the PID. I currently don't think it's useful to be able to see what the PID of the process had been, because by now it has already exited. Some features still to think about: * Should it `kill()` the process with a specified signal on `$f->cancel`? * Should it `$f->fail` on non-zero exit code? These can both be added in a later version. -- Paul Evans
Subject: rt129225.patch
Download rt129225.patch
text/x-diff 5k
=== modified file 'lib/IO/Async/Loop.pm' --- lib/IO/Async/Loop.pm 2019-04-18 13:09:41 +0000 +++ lib/IO/Async/Loop.pm 2019-06-12 15:05:59 +0000 @@ -1281,6 +1281,66 @@ return $process->pid; } +=head2 run_process + + @results = $loop->run_process( %params )->get + + ( $exitcode, $stdout ) = $loop->run_process( ... )->get # by default + +I<Since version 0.73.> + +Creates a new child process to run the given code block or command, optionally +capturing its STDOUT and STDERR streams. By default the returned future will +yield the exit code and content of the STDOUT stream, but the C<capture> +argument can be used to alter what is requested and returned. + +The method is a wrapper of L</run_child> and accepts the same parameters, +except C<on_finish>. + +Additionally, takes the following named arguments: + +=over 8 + +=item capture => ARRAY + +Optional, a list of names which should be returned by resolving future. Values +will be returned in the same order as in the list. Valid choices are: +C<exitcode>, C<stdout>, C<stderr>. + +=back + +=cut + +my @process_captures = qw(exitcode stdout stderr); + +sub run_process +{ + my $self = shift; + my %params = @_; + + $params{on_finish} and croak "Unrecognised parameter on_finish"; + + my $capture = delete $params{capture} // [qw(exitcode stdout)]; + ref $capture eq "ARRAY" or croak "Expected 'capture' to be an array reference"; + + foreach my $name ( @$capture ) { + grep { $_ eq $name } @process_captures or croak "Unexpected capture $name"; + } + + my $future = $self->new_future; + my $pid = $self->run_child( + %params, + on_finish => sub { + my %results; + @results{qw( pid exitcode stdout stderr )} = @_; + + $future->done( @results{ @$capture } ); + }, + ); + + return $future; +} + =head2 resolver $loop->resolver === added file 't/39loop-runproccess.t' --- t/39loop-runproccess.t 1970-01-01 00:00:00 +0000 +++ t/39loop-runproccess.t 2019-06-12 15:05:59 +0000 @@ -0,0 +1,131 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use IO::Async::Test; + +use Test::More; +use Test::Fatal; + +use IO::Async::Loop; +use IO::Async::OS; + +plan skip_all => "POSIX fork() is not available" unless IO::Async::OS->HAVE_POSIX_FORK; + +my $loop = IO::Async::Loop->new_builtin; +testing_loop( $loop ); + +# run_process capture exitcode +{ + my $f; + + $f = $loop->run_process( + code => sub { 3 }, + capture => [qw( exitcode )], + ); + is_deeply( [ $f->get ], [ 3 << 8 ], + '$f->get from code gives exitcode' ); + + $f = $loop->run_process( + command => [ $^X, "-e", 'exit 5' ], + capture => [qw( exitcode )], + ); + is_deeply( [ $f->get ], [ 5 << 8 ], + '$f->get from command gives exitcode' ); +} + +# run_process capture stdout +{ + my $f; + + $f = $loop->run_process( + code => sub { print "hello\n"; 0 }, + capture => [qw( stdout )], + ); + is_deeply( [ $f->get ], [ "hello\n" ], + '$f->get from code gives stdout' ); + + $f = $loop->run_process( + command => [ $^X, "-e", 'print "goodbye\n"' ], + capture => [qw( stdout )], + ); + is_deeply( [ $f->get ], [ "goodbye\n" ], + '$f->get from command gives stdout' ); +} + +# run_process capture stdout and stderr +{ + my $f; + + $f = $loop->run_process( + command => [ $^X, "-e", 'print STDOUT "output\n"; print STDERR "error\n";' ], + capture => [qw( stdout stderr )], + ); + is_deeply( [ $f->get ], [ "output\n", "error\n" ], + '$f->get from command gives stdout and stderr' ); +} + +# run_process sending stdin +{ + my $f; + + # perl -pe 1 behaves like cat; copies STDIN to STDOUT + $f = $loop->run_process( + command => [ $^X, "-pe", '1' ], + stdin => "some data\n", + capture => [qw( stdout )], + ); + is_deeply( [ $f->get ], [ "some data\n" ], + '$f->get from command given stdin gives stdout' ); +} + +# run_process default capture +{ + my $f = $loop->run_process( + command => [ $^X, "-e", 'print STDOUT "output"; print STDERR "error";' ], + ); + is_deeply( [ $f->get ], [ 0, "output" ], + '$f->get from command with default capture' ); +} + +# run_process captures in weird order +{ + my $f = $loop->run_process( + command => [ $^X, "-e", 'print STDOUT "output"; print STDERR "error";' ], + capture => [qw(stderr exitcode stdout)], + ); + is_deeply( [ $f->get ], [ "error", 0, "output" ], + '$f->get from command with all captures' ); +} + +# Testing error handling +ok( exception { $loop->run_process( + command => [ $^X, "-e", 1 ], + some_key_you_fail => 1 + ) }, + 'unrecognised key fails' +); + +ok( exception { $loop->run_process( + command => [ $^X, "-e", 1 ], + capture => 'pid' + ) }, + 'Capture in capture format' +); + +ok( exception { $loop->run_process( + command => [ $^X, "-e", 1 ], + capture => ['invalid_capture'] + ) }, + 'Invalid capture type' +); + +ok( exception { $loop->run_process( + command => [ $^X, "-e", 1 ], + on_finish => sub{ 0 } + ) }, + 'Failing when finish callback is passed' +); + +done_testing;


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.