From 71aa4d4326f95df8b68c33d3ee4b0cecd95b22f8 Mon Sep 17 00:00:00 2001 From: Graham Ollis Date: Sun, 30 Aug 2026 22:04:37 -0600 Subject: [PATCH 1/3] starter --- .github/workflows/linux.yml | 17 ++++------------- lib/IO/Async/Open3/Simple.pm | 8 ++++---- 2 files changed, 8 insertions(+), 17 deletions(-) diff --git a/.github/workflows/linux.yml b/.github/workflows/linux.yml index ea8cb20..ebb3f8c 100644 --- a/.github/workflows/linux.yml +++ b/.github/workflows/linux.yml @@ -17,24 +17,15 @@ jobs: fail-fast: false matrix: cip_tag: - - "5.41" - - "5.40" - - "5.38" - - "5.36" - - "5.34" - - "5.32" - - "5.30" - - "5.28" - - "5.26" - - "5.24" - - "5.22" - - "5.20" + - "5.45" + - "5.44" + - "5.42" env: CIP_TAG: ${{ matrix.cip_tag }} steps: - - uses: actions/checkout@v6 + - uses: actions/checkout@v7 - name: Bootstrap CIP run: | diff --git a/lib/IO/Async/Open3/Simple.pm b/lib/IO/Async/Open3/Simple.pm index 3dd5087..db2efe5 100644 --- a/lib/IO/Async/Open3/Simple.pm +++ b/lib/IO/Async/Open3/Simple.pm @@ -1,7 +1,7 @@ +package IO::Async::Open3::Simple; + +# ABSTRACT: Interface to open3 under IO::Async + use warnings; use v5.42; -package IO::Async::Open3::Simple { - - # ABSTRACT: Interface to open3 under IO::Async -} From 5ed8828eb988c128553a1cfd2629f58e30277d4e Mon Sep 17 00:00:00 2001 From: Graham Ollis Date: Sun, 30 Aug 2026 22:08:57 -0600 Subject: [PATCH 2/3] req 2.79 --- dist.ini | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/dist.ini b/dist.ini index 41e5550..85cb96c 100644 --- a/dist.ini +++ b/dist.ini @@ -6,7 +6,7 @@ copyright_year = 2026 version = 0.01 [@Author::Plicease] -:version = 2.80 +:version = 2.79 release_tests = 1 installer = Author::Plicease::MakeMaker github_user = uperl From f9edba8658b7a2b49353f2445258c464ce354c75 Mon Sep 17 00:00:00 2001 From: Graham Ollis Date: Sun, 30 Aug 2026 22:45:21 -0600 Subject: [PATCH 3/3] initial implementation --- .gitignore | 1 + .perltidyrc | 80 +++++ README.md | 281 +++++++++++++++ author.yml | 3 +- dist.ini | 3 + lib/IO/Async/Open3/Simple.pm | 415 ++++++++++++++++++++++- lib/IO/Async/Open3/Simple/Process.pm | 125 +++++++ t/00_diag.t | 89 +++++ t/io_async_open3_simple.t | 29 +- t/io_async_open3_simple__gh1.t | 28 ++ t/io_async_open3_simple__on_error.t | 38 +++ t/io_async_open3_simple__on_error_mock.t | 40 +++ t/io_async_open3_simple__on_fail.t | 48 +++ t/io_async_open3_simple__on_out.t | 38 +++ t/io_async_open3_simple__on_out_array.t | 35 ++ t/io_async_open3_simple__on_signal.t | 48 +++ t/io_async_open3_simple__on_start.t | 53 +++ t/io_async_open3_simple__on_success.t | 46 +++ t/io_async_open3_simple__print.t | 45 +++ t/io_async_open3_simple__proc.t | 43 +++ t/io_async_open3_simple__process.t | 16 + t/io_async_open3_simple__run_no_args.t | 10 + t/io_async_open3_simple__stdin.t | 45 +++ xt/author/critic.t | 6 +- 24 files changed, 1555 insertions(+), 10 deletions(-) create mode 100644 .perltidyrc create mode 100644 README.md create mode 100644 lib/IO/Async/Open3/Simple/Process.pm create mode 100644 t/00_diag.t create mode 100644 t/io_async_open3_simple__gh1.t create mode 100644 t/io_async_open3_simple__on_error.t create mode 100644 t/io_async_open3_simple__on_error_mock.t create mode 100644 t/io_async_open3_simple__on_fail.t create mode 100644 t/io_async_open3_simple__on_out.t create mode 100644 t/io_async_open3_simple__on_out_array.t create mode 100644 t/io_async_open3_simple__on_signal.t create mode 100644 t/io_async_open3_simple__on_start.t create mode 100644 t/io_async_open3_simple__on_success.t create mode 100644 t/io_async_open3_simple__print.t create mode 100644 t/io_async_open3_simple__proc.t create mode 100644 t/io_async_open3_simple__process.t create mode 100644 t/io_async_open3_simple__run_no_args.t create mode 100644 t/io_async_open3_simple__stdin.t diff --git a/.gitignore b/.gitignore index 2a394e3..89d160e 100644 --- a/.gitignore +++ b/.gitignore @@ -1,3 +1,4 @@ IO-Async-Open3-Simple-* /.build/ *.swp +*.bak diff --git a/.perltidyrc b/.perltidyrc new file mode 100644 index 0000000..29892c9 --- /dev/null +++ b/.perltidyrc @@ -0,0 +1,80 @@ +# Initialized via perltidy -b -w -dop | grep -v dump-options > .perltidyrc +--add-newlines +--add-semicolons +--add-whitespace +--backup-and-modify-in-place +--backup-file-extension="bak" +--blank-lines-before-packages=1 +--blank-lines-before-subs=1 +--blanks-before-blocks +--noblanks-before-comments +--block-brace-tightness=0 +--block-brace-vertical-tightness=0 +--nobrace-left-and-indent +--brace-tightness=1 +--brace-vertical-tightness=0 +--brace-vertical-tightness-closing=0 +--break-at-old-attribute-breakpoints +--break-at-old-keyword-breakpoints +--break-at-old-logical-breakpoints +--break-at-old-method-breakpoints +--break-at-old-ternary-breakpoints +--nocheck-syntax +--closing-brace-indentation=0 +--closing-paren-indentation=0 +--closing-side-comment-else-flag=0 +--closing-side-comment-interval=6 +--closing-side-comment-maximum-text=20 +--closing-side-comments-balanced +--closing-square-bracket-indentation=0 +--comma-arrow-breakpoints=5 +--continuation-indentation=2 +--cuddled-else +--default-tabsize=8 +--delete-old-newlines +--nodelete-old-whitespace +--delete-semicolons +--format="tidy" +--format-skipping +--fuzzy-line-length +--hanging-side-comments +--nohtml +--html-entities +--html-table-of-contents +--indent-block-comments +--indent-columns=4 +--iterations=1 +--keep-old-blank-lines=1 +--nologfile +--long-block-line-count=8 +--look-for-autoloader +--look-for-selfloader +--maximum-consecutive-blank-lines=1 +--maximum-fields-per-table=0 +--maximum-line-length=120 +--memoize +--minimum-space-to-comment=4 +--outdent-labels +--outdent-long-comments +--outdent-long-quotes +--paren-tightness=1 +--paren-vertical-tightness=0 +--paren-vertical-tightness-closing=0 +--pass-version-line +--perl-syntax-check-flags="-c -T" +--pod2html +--noquiet +--recombine +--short-concatenation-item-length=8 +--noshow-options +--space-for-semicolon +--square-bracket-tightness=1 +--square-bracket-vertical-tightness=0 +--square-bracket-vertical-tightness-closing=0 +--static-block-comments +--nostatic-side-comments +--notabs +--trim-qw +--valign +--warning-output +--character-encoding=utf8 diff --git a/README.md b/README.md new file mode 100644 index 0000000..58bcc15 --- /dev/null +++ b/README.md @@ -0,0 +1,281 @@ +# IO::Async::Open3::Simple ![static](https://github.com/uperl/IO-Async-Open3-Simple/workflows/static/badge.svg) ![linux](https://github.com/uperl/IO-Async-Open3-Simple/workflows/linux/badge.svg) + +Interface to open3 under IO::Async + +# SYNOPSIS + +```perl +use v5.42; +use IO::Async::Loop; +use IO::Async::Open3::Simple; + +my $loop = IO::Async::Loop->new; +my $done = $loop->new_future; + +my $ipc = IO::Async::Open3::Simple->new( + on_start => sub { + my $proc = shift; # isa IO::Async::Open3::Simple::Process + my $program = shift; # string + my @args = @_; # list of arguments + say 'child PID: ', $proc->pid; + }, + on_stdout => sub { + my $proc = shift; # isa IO::Async::Open3::Simple::Process + my $line = shift; # string + say 'out: ', $line; + }, + on_stderr => sub { + my $proc = shift; # isa IO::Async::Open3::Simple::Process + my $line = shift; # string + say 'err: ', $line; + }, + on_exit => sub { + my $proc = shift; # isa IO::Async::Open3::Simple::Process + my $exit_value = shift; # integer + my $signal = shift; # integer + say 'exit value: ', $exit_value; + say 'signal: ', $signal; + $done->done; + }, + on_error => sub { + my $error = shift; # the exception thrown by IPC::Open3::open3 + my $program = shift; # string + my @args = @_; # list of arguments + warn "error: $error"; + $done->done; + }, +); + +$ipc->run('echo', 'hello there'); +$done->get; +``` + +# DESCRIPTION + +This module provides an interface to open3 while running under [IO::Async](https://metacpan.org/pod/IO::Async) +that delivers data from stdout and stderr as lines are written by the +subprocess. The interface is reminiscent of [IPC::Open3::Simple](https://metacpan.org/pod/IPC::Open3::Simple), +although this module does provide a somewhat different API, so it +cannot be used as a drop in replacement for that module. + +It is intended as a drop in replacement for [AnyEvent::Open3::Simple](https://metacpan.org/pod/AnyEvent::Open3::Simple), +for code that would rather use [IO::Async](https://metacpan.org/pod/IO::Async) as its event loop. Aside +from the `AnyEvent` specific parts (the `implementation` attribute +and the `ANYEVENT_OPEN3_SIMPLE` environment variable, neither of which +apply here), the API is the same. + +[IO::Async](https://metacpan.org/pod/IO::Async) comes with a robust interface to do the same thing as this +module: [IO::Async::Process](https://metacpan.org/pod/IO::Async::Process), which you more than likely want to use +instead. This module is primarily intended for applications that are +already using [AnyEvent::Open3::Simple](https://metacpan.org/pod/AnyEvent::Open3::Simple) and only want to change the +underlying event loop. + +# CONSTRUCTOR + +Constructor takes a hash or hashref of event callbacks and attributes. +Event callbacks have an `on_` prefix, attributes do not. + +## ATTRIBUTES + +- loop + + The [IO::Async::Loop](https://metacpan.org/pod/IO::Async::Loop) to use. If not provided the shared loop returned + by `IO::Async::Loop->new` is used, which is almost always what you + want. + +- implementation + + Accepted and ignored for compatibility with [AnyEvent::Open3::Simple](https://metacpan.org/pod/AnyEvent::Open3::Simple). + Under [IO::Async](https://metacpan.org/pod/IO::Async) there is only one implementation: an [IO::Async::Stream](https://metacpan.org/pod/IO::Async::Stream) + for each of stdout and stderr, and `$loop->watch_process` to detect + process termination. + +## EVENTS + +These events will be triggered by the subprocess when the run method is +called. Each event callback (except `on_error`) gets passed in an +instance of [IO::Async::Open3::Simple::Process](https://metacpan.org/pod/IO::Async::Open3::Simple::Process) as its first argument +which can be used to get the PID of the subprocess, or to write to it. +`on_error` does not get a process object because it indicates an error in +the creation of the process. + +Not all of these events will fire depending on the execution of the +child process. In the very least exactly one of `on_start` or `on_error` +will be called. + +- `on_start` ($proc, $program, @arguments) + + Called after the process is created, but before the run method returns + (that is, it does not wait to re-enter the event loop first). + + This event also gets the program name and arguments passed into the + [run](https://metacpan.org/pod/IO::Async::Open3::Simple#run) method. + +- `on_error` ($error, $program, @arguments) + + Called when there is an execution error, for example, if you ask + to run a program that does not exist. No process is passed in + because the process failed to create. The error passed in is + the error thrown by [IPC::Open3](https://metacpan.org/pod/IPC::Open3) (typically a string which begins + with "open3: ..."). + + In some environments open3 is unable to detect exec errors in the + child, so you may not be able to rely on this event. It does + seem to work consistently on Perl 5.14 or better though. + + Different environments have different ways of handling it when + you ask to run a program that doesn't exist. On Linux and Cygwin, + this will raise an `on_error` event, on `MSWin32` it will + not trigger a `on_error` and instead cause a normal exit + with a exit value of 1. + + This event also gets the program name and arguments passed into the + [run](https://metacpan.org/pod/IO::Async::Open3::Simple#run) method. + +- `on_stdout` ($proc, $line) + + Called on every line printed to stdout by the child process. + +- `on_stderr` ($proc, $line) + + Called on every line printed to stderr by the child process. + +- `on_exit` ($proc, $exit\_value, $signal) + + Called when the processes completes, either because it called exit, + or if it was killed by a signal. + +- `on_success` ($proc) + + Called when the process returns zero exit value and is not terminated by a signal. + +- `on_signal` ($proc, $signal) + + Called when the processes is terminated by a signal. + +- `on_fail` ($proc, $exit\_value) + + Called when the process returns a non-zero exit value. + +# METHODS + +## run + +```perl +$ipc->run($program, @arguments); +$ipc->run($program, @arguments, \$stdin); +$ipc->run($program, @arguments, \@stdin); +$ipc->run($program, @arguments, sub {...}); +$ipc->run($program, @arguments, \$stdin, sub {...}); +$ipc->run($program, @arguments, \@stdin, sub {...}); +``` + +Start the given program with the given arguments. Returns +immediately (it returns the [IO::Async::Open3::Simple](https://metacpan.org/pod/IO::Async::Open3::Simple) instance). +Any events that have been specified in the constructor (except for +`on_start`) will not be called until the process re-enters the +event loop. + +You may optionally provide the full content of standard input +as a string reference or list reference as the last argument +(or second to last if you are providing a callback below). +If provided as a list reference, it will be joined by new lines +in whatever format is native to your Perl. Currently on +(non cygwin) Windows (Strawberry, ActiveState) this is the only +way to provide standard input to the subprocess. + +Do not mix the use of passing standard input to [run](https://metacpan.org/pod/IO::Async::Open3::Simple#run) +and [IO::Async::Open3::Simple::Process#print](https://metacpan.org/pod/IO::Async::Open3::Simple::Process#print) or [IO::Async::Open3::Simple::Process#say](https://metacpan.org/pod/IO::Async::Open3::Simple::Process#say), +otherwise bad things may happen. + +You may provide a callback as the last argument which is called before +`on_start`, and takes the process object as its only argument. For +example: + +```perl +foreach my $i (1..10) +{ + $ipc->run($prog, @args, \$stdin, sub { + my($proc) = @_; + $proc->user({ iteration => $i }); + }); +} +``` + +This is useful for making data accessible to `$ipc` object's callbacks that may +be out of scope otherwise. + +# CAVEATS + +There are some traps for the unwary relating to buffers and deadlocks, +[IPC::Open3](https://metacpan.org/pod/IPC::Open3) is recommended reading. + +Unlike [AnyEvent::Open3::Simple](https://metacpan.org/pod/AnyEvent::Open3::Simple), this module waits for the child's +stdout and stderr pipes to reach end of file (in addition to the child +process being reaped) before firing `on_exit`. This guarantees that +every line of output is delivered before `on_exit`, but a grandchild +process which inherits and holds open the pipes can delay the event. + +If you register a call back for `on_exit`, but not `on_error` then +use a [Future](https://metacpan.org/pod/Future) (or condition variable, or `$loop->run` / `$loop->stop`) +to wait for the process to complete as in this: + +```perl +my $done = $loop->new_future; +my $ipc = IO::Async::Open3::Simple->new( + on_exit => sub { $done->done }, +); +$ipc->run('command_not_found'); +$done->get; +``` + +You might be waiting forever if there is an error starting the +process (if for example you give it a bad command). To handle +this situation you might fail the Future in the event of error: + +```perl +my $done = $loop->new_future; +my $ipc = IO::Async::Open3::Simple->new( + on_exit => sub { $done->done }, + on_error => sub { + my $error = shift; + $done->fail($error); + }, +); +$ipc->run('command_not_found'); +$done->get; +``` + +This will cause the `get` to die, printing a useful diagnostic +if the exception isn't caught somewhere else. + +Writing to a subprocesses stdin with [IO::Async::Open3::Simple::Process#print](https://metacpan.org/pod/IO::Async::Open3::Simple::Process#print) +or [IO::Async::Open3::Simple::Process#say](https://metacpan.org/pod/IO::Async::Open3::Simple::Process#say) is unsupported on Microsoft +Windows (it does work under Cygwin though). + +# SEE ALSO + +- [IO::Async::Open3::Simple::Process](https://metacpan.org/pod/IO::Async::Open3::Simple::Process) + + Represents a process being run by this module, typically passed + into the callbacks. + +- [AnyEvent::Open3::Simple](https://metacpan.org/pod/AnyEvent::Open3::Simple) + + The module this one is based on, for use with [AnyEvent](https://metacpan.org/pod/AnyEvent) instead + of [IO::Async](https://metacpan.org/pod/IO::Async). + +- [IO::Async::Process](https://metacpan.org/pod/IO::Async::Process) + + Alternative to this module included with [IO::Async](https://metacpan.org/pod/IO::Async). + +# AUTHOR + +Graham Ollis + +# COPYRIGHT AND LICENSE + +This software is copyright (c) 2026 by Graham Ollis. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. diff --git a/author.yml b/author.yml index c64a272..4790368 100644 --- a/author.yml +++ b/author.yml @@ -11,4 +11,5 @@ pod_coverage: skip: 0 # format is "Class#method" or "Class",regex allowed # for either Class or method. - private: [] + private: + - ".*#new" diff --git a/dist.ini b/dist.ini index 85cb96c..8e9078b 100644 --- a/dist.ini +++ b/dist.ini @@ -18,6 +18,9 @@ version_plugin = PkgVersion::Block [Author::Plicease::Core] +[Prereqs] +IO::Async = 0.76 + [Author::Plicease::Upload] cpan = 1 diff --git a/lib/IO/Async/Open3/Simple.pm b/lib/IO/Async/Open3/Simple.pm index db2efe5..a477f06 100644 --- a/lib/IO/Async/Open3/Simple.pm +++ b/lib/IO/Async/Open3/Simple.pm @@ -1,7 +1,414 @@ -package IO::Async::Open3::Simple; +use warnings; +use 5.042; -# ABSTRACT: Interface to open3 under IO::Async +package IO::Async::Open3::Simple { -use warnings; -use v5.42; + use IPC::Open3 qw( open3 ); + use Scalar::Util qw( reftype ); + use Symbol qw( gensym ); + use IO::Async::Loop; + use IO::Async::Stream; + use IO::Async::Open3::Simple::Process; + use Carp qw( croak ); + use File::Temp (); + + # ABSTRACT: Interface to open3 under IO::Async + +=head1 SYNOPSIS + + use v5.42; + use IO::Async::Loop; + use IO::Async::Open3::Simple; + + my $loop = IO::Async::Loop->new; + my $done = $loop->new_future; + + my $ipc = IO::Async::Open3::Simple->new( + on_start => sub { + my $proc = shift; # isa IO::Async::Open3::Simple::Process + my $program = shift; # string + my @args = @_; # list of arguments + say 'child PID: ', $proc->pid; + }, + on_stdout => sub { + my $proc = shift; # isa IO::Async::Open3::Simple::Process + my $line = shift; # string + say 'out: ', $line; + }, + on_stderr => sub { + my $proc = shift; # isa IO::Async::Open3::Simple::Process + my $line = shift; # string + say 'err: ', $line; + }, + on_exit => sub { + my $proc = shift; # isa IO::Async::Open3::Simple::Process + my $exit_value = shift; # integer + my $signal = shift; # integer + say 'exit value: ', $exit_value; + say 'signal: ', $signal; + $done->done; + }, + on_error => sub { + my $error = shift; # the exception thrown by IPC::Open3::open3 + my $program = shift; # string + my @args = @_; # list of arguments + warn "error: $error"; + $done->done; + }, + ); + + $ipc->run('echo', 'hello there'); + $done->get; + +=head1 DESCRIPTION + +This module provides an interface to open3 while running under L +that delivers data from stdout and stderr as lines are written by the +subprocess. The interface is reminiscent of L, +although this module does provide a somewhat different API, so it +cannot be used as a drop in replacement for that module. + +It is intended as a drop in replacement for L, +for code that would rather use L as its event loop. Aside +from the C specific parts (the C attribute +and the C environment variable, neither of which +apply here), the API is the same. + +L comes with a robust interface to do the same thing as this +module: L, which you more than likely want to use +instead. This module is primarily intended for applications that are +already using L and only want to change the +underlying event loop. + +=head1 CONSTRUCTOR + +Constructor takes a hash or hashref of event callbacks and attributes. +Event callbacks have an C prefix, attributes do not. + +=head2 ATTRIBUTES + +=over 4 + +=item * loop + +The L to use. If not provided the shared loop returned +by C<< IO::Async::Loop->new >> is used, which is almost always what you +want. + +=item * implementation + +Accepted and ignored for compatibility with L. +Under L there is only one implementation: an L +for each of stdout and stderr, and C<< $loop->watch_process >> to detect +process termination. + +=back + +=head2 EVENTS + +These events will be triggered by the subprocess when the run method is +called. Each event callback (except C) gets passed in an +instance of L as its first argument +which can be used to get the PID of the subprocess, or to write to it. +C does not get a process object because it indicates an error in +the creation of the process. + +Not all of these events will fire depending on the execution of the +child process. In the very least exactly one of C or C +will be called. + +=over 4 + +=item * C ($proc, $program, @arguments) + +Called after the process is created, but before the run method returns +(that is, it does not wait to re-enter the event loop first). + +This event also gets the program name and arguments passed into the +L method. + +=item * C ($error, $program, @arguments) + +Called when there is an execution error, for example, if you ask +to run a program that does not exist. No process is passed in +because the process failed to create. The error passed in is +the error thrown by L (typically a string which begins +with "open3: ..."). + +In some environments open3 is unable to detect exec errors in the +child, so you may not be able to rely on this event. It does +seem to work consistently on Perl 5.14 or better though. + +Different environments have different ways of handling it when +you ask to run a program that doesn't exist. On Linux and Cygwin, +this will raise an C event, on C it will +not trigger a C and instead cause a normal exit +with a exit value of 1. + +This event also gets the program name and arguments passed into the +L method. + +=item * C ($proc, $line) + +Called on every line printed to stdout by the child process. + +=item * C ($proc, $line) + +Called on every line printed to stderr by the child process. + +=item * C ($proc, $exit_value, $signal) + +Called when the processes completes, either because it called exit, +or if it was killed by a signal. + +=item * C ($proc) + +Called when the process returns zero exit value and is not terminated by a signal. + +=item * C ($proc, $signal) + +Called when the processes is terminated by a signal. + +=item * C ($proc, $exit_value) + +Called when the process returns a non-zero exit value. + +=back + +=cut + + sub new ( $class, @rest ) { + my $default_handler = sub { }; + my $args = ( reftype( $rest[0] ) || '' ) eq 'HASH' ? $rest[0] : {@rest}; + my %self; + croak "stdin passed into IO::Async::Open3::Simple->new no longer supported" if $args->{stdin}; + croak "raw passed into IO::Async::Open3::Simple->new no longer supported" if $args->{raw}; + $self{$_} = $args->{$_} || $default_handler + for qw( on_stdout on_stderr on_start on_exit on_signal on_fail on_error on_success ); + $self{loop} = $args->{loop} if $args->{loop}; + bless \%self, $class; + } + +=head1 METHODS + +=head2 run + + $ipc->run($program, @arguments); + $ipc->run($program, @arguments, \$stdin); + $ipc->run($program, @arguments, \@stdin); + $ipc->run($program, @arguments, sub {...}); + $ipc->run($program, @arguments, \$stdin, sub {...}); + $ipc->run($program, @arguments, \@stdin, sub {...}); + +Start the given program with the given arguments. Returns +immediately (it returns the L instance). +Any events that have been specified in the constructor (except for +C) will not be called until the process re-enters the +event loop. + +You may optionally provide the full content of standard input +as a string reference or list reference as the last argument +(or second to last if you are providing a callback below). +If provided as a list reference, it will be joined by new lines +in whatever format is native to your Perl. Currently on +(non cygwin) Windows (Strawberry, ActiveState) this is the only +way to provide standard input to the subprocess. + +Do not mix the use of passing standard input to L +and L or L, +otherwise bad things may happen. + +You may provide a callback as the last argument which is called before +C, and takes the process object as its only argument. For +example: + + foreach my $i (1..10) + { + $ipc->run($prog, @args, \$stdin, sub { + my($proc) = @_; + $proc->user({ iteration => $i }); + }); + } + +This is useful for making data accessible to C<$ipc> object's callbacks that may +be out of scope otherwise. + +=cut + + sub run ( $self, @arguments ) { + croak "run method requires at least one argument" + unless @arguments >= 1; + + my $proc_user = ( ref $arguments[-1] eq 'CODE' ? pop @arguments : sub ($proc) { } ); + + my $stdin; + $stdin = pop @arguments if @arguments && ref $arguments[-1]; + + my $program = shift @arguments; + + my ( $child_stdin, $child_stdout, $child_stderr ); + $child_stderr = gensym; + + # keep the temp file alive until open3 has dup'd it into the child + my $stdin_file; + if ( defined $stdin ) { + $stdin_file = File::Temp->new; + $stdin_file->autoflush(1); + $stdin_file->print( + ref($stdin) eq 'ARRAY' + ? join( "\n", @{$stdin} ) + : $$stdin + ); + $stdin_file->seek( 0, 0 ); + $child_stdin = '<&' . fileno($stdin_file); + } + + my $loop = $self->{loop} ||= IO::Async::Loop->new; + + my $pid = eval { open3 $child_stdin, $child_stdout, $child_stderr, $program, @arguments }; + + if ( my $error = $@ ) { + $self->{on_error}->( $error, $program, @arguments ); + return; + } + + my $proc = IO::Async::Open3::Simple::Process->new( $pid, $child_stdin ); + $proc_user->($proc); + + $self->{on_start}->( $proc, $program, @arguments ); + + my $emit = sub ( $ref, $line ) { + $line =~ s/(\015?\012|\015)$//; + ref($ref) eq 'ARRAY' ? ( push @$ref, $line ) : $ref->( $proc, $line ); + return; + }; + + my $stdout_open = 1; + my $stderr_open = 1; + my $exited = 0; + my ( $exit_value, $signal ); + + my ( $stdout_stream, $stderr_stream ); + + my $finish = sub () { + return if $stdout_open || $stderr_open || !$exited; + + $proc->close; + + $self->{on_exit}->( $proc, $exit_value, $signal ); + $self->{on_signal}->( $proc, $signal ) if $signal > 0; + $self->{on_fail}->( $proc, $exit_value ) if $exit_value > 0; + $self->{on_success}->($proc) if $signal == 0 && $exit_value == 0; + + undef $stdout_stream; + undef $stderr_stream; + undef $proc; + return; + }; + + my $make_stream = sub ( $handle, $which, $open_ref ) { + my $stream = IO::Async::Stream->new( + read_handle => $handle, + on_read => sub ( $, $buffref, $eof ) { + while ( $$buffref =~ s/^(.*?\012)// ) { + $emit->( $self->{$which}, $1 ); + } + if ( $eof && length $$buffref ) { + my $line = $$buffref; + $$buffref = ''; + $emit->( $self->{$which}, $line ); + } + return 0; + }, + on_read_eof => sub ($) { + $$open_ref = 0; + $finish->(); + return; + }, + ); + $loop->add($stream); + return $stream; + }; + + $stdout_stream = $make_stream->( $child_stdout, 'on_stdout', \$stdout_open ); + $stderr_stream = $make_stream->( $child_stderr, 'on_stderr', \$stderr_open ); + + $loop->watch_process( + $pid => sub ( $, $status ) { + ( $exit_value, $signal ) = ( $status >> 8, $status & 127 ); + $exited = 1; + $finish->(); + return; + } + ); + + $self; + } + +} + +=head1 CAVEATS + +There are some traps for the unwary relating to buffers and deadlocks, +L is recommended reading. + +Unlike L, this module waits for the child's +stdout and stderr pipes to reach end of file (in addition to the child +process being reaped) before firing C. This guarantees that +every line of output is delivered before C, but a grandchild +process which inherits and holds open the pipes can delay the event. + +If you register a call back for C, but not C then +use a L (or condition variable, or C<< $loop->run >> / C<< $loop->stop >>) +to wait for the process to complete as in this: + + my $done = $loop->new_future; + my $ipc = IO::Async::Open3::Simple->new( + on_exit => sub { $done->done }, + ); + $ipc->run('command_not_found'); + $done->get; + +You might be waiting forever if there is an error starting the +process (if for example you give it a bad command). To handle +this situation you might fail the Future in the event of error: + + my $done = $loop->new_future; + my $ipc = IO::Async::Open3::Simple->new( + on_exit => sub { $done->done }, + on_error => sub { + my $error = shift; + $done->fail($error); + }, + ); + $ipc->run('command_not_found'); + $done->get; + +This will cause the C to die, printing a useful diagnostic +if the exception isn't caught somewhere else. + +Writing to a subprocesses stdin with L +or L is unsupported on Microsoft +Windows (it does work under Cygwin though). + +=head1 SEE ALSO + +=over 4 + +=item L + +Represents a process being run by this module, typically passed +into the callbacks. + +=item L + +The module this one is based on, for use with L instead +of L. + +=item L + +Alternative to this module included with L. + +=back +=cut diff --git a/lib/IO/Async/Open3/Simple/Process.pm b/lib/IO/Async/Open3/Simple/Process.pm new file mode 100644 index 0000000..85ac674 --- /dev/null +++ b/lib/IO/Async/Open3/Simple/Process.pm @@ -0,0 +1,125 @@ +use warnings; +use 5.042; + +package IO::Async::Open3::Simple::Process { + + # ABSTRACT: Process run using IO::Async::Open3::Simple + +=head1 DESCRIPTION + +This class represents a process being handled by L. + +=cut + + sub new ( $class, $pid, $stdin ) { + bless { pid => $pid, stdin => $stdin, user => '' }, $class; + } + +=head1 ATTRIBUTES + +=head2 pid + + my $pid = $proc->pid; + +Return the Process ID of the child process. + +=cut + + sub pid ($self) { $self->{pid} } + +=head1 METHODS + +=head2 print + + $proc->print(@data); + +Write to the subprocess' stdin. + +Do NOT use this method if you have passed stdin via the C<$stdin> argument +on the L method. + +Currently on (non cygwin) Windows (Strawberry, ActiveState) this method is not +supported, so if you need to send (standard) input to the subprocess, you must pass +it into the L method. + +=head2 say + + $proc->say(@data); + +Write to the subprocess' stdin, adding a new line at the end. + +Do NOT use this method if you have passed stdin via the C<$stdin> argument +on the L method. + +Currently on (non cygwin) Windows (Strawberry, ActiveState) this method is not +supported, so if you need to send (standard) input to the subprocess, you must pass +it into the L method. + +=cut + + if ( $^O eq 'MSWin32' ) { + require Carp; + *print = sub (@) { Carp::croak("IO::Async::Open3::Simple::Process#print is unsupported on this platform") }; + *say = sub (@) { Carp::croak("IO::Async::Open3::Simple::Process#say is unsupported on this platform") }; + } else { + *print = sub ( $self, @data ) { + my $stdin = $self->{stdin}; + print $stdin @data; + }; + *say = sub ( $self, @data ) { + my $stdin = $self->{stdin}; + print $stdin @data, "\n"; + }; + } + +=head2 close + + $proc->close + +Close the subprocess' stdin. + +=cut + + sub close ($self) { + CORE::close( $self->{stdin} ); + } + +=head2 user + + $proc->user($user_data); + my $user_data = $proc->user; + +Get or set user defined data tied to the process object. Any +Perl data structure may be used. Useful for persisting data +between callbacks, for example: + + IO::Async::Open3::Simple->new( + on_start => sub { + my($proc) = @_; + $proc->user({ prefix => '> ' }); + }, + on_stdout => sub { + my($proc, $line) = @_; + my $prefix = $proc->user->{prefix}; + say "$prefix$line"; + }, + ); + +=cut + + sub user ( $self, $data = undef ) { + $self->{user} = $data if defined $data; + $self->{user}; + } + +} + +=head1 SEE ALSO + +=over 4 + +=item L + +=back + +=cut diff --git a/t/00_diag.t b/t/00_diag.t new file mode 100644 index 0000000..91113de --- /dev/null +++ b/t/00_diag.t @@ -0,0 +1,89 @@ +use Test2::V0 -no_srand => 1; +use Config; + +eval { require 'Test/More.pm' }; + +# This .t file is generated. +# make changes instead to dist.ini + +my %modules; +my $post_diag; + +$modules{$_} = $_ for qw( + ExtUtils::MakeMaker + IO::Async + IO::Async::Loop + IO::Async::Stream + Test2::V0 +); + + + +my @modules = sort keys %modules; + +sub spacer () +{ + diag ''; + diag ''; + diag ''; +} + +pass 'okay'; + +my $max = 1; +$max = $_ > $max ? $_ : $max for map { length $_ } @modules; +our $format = "%-${max}s %s"; + +spacer; + +my @keys = sort grep /(MOJO|PERL|\A(LC|HARNESS)_|\A(SHELL|LANG)\Z)/i, keys %ENV; + +if(@keys > 0) +{ + diag "$_=$ENV{$_}" for @keys; + + if($ENV{PERL5LIB}) + { + spacer; + diag "PERL5LIB path"; + diag $_ for split $Config{path_sep}, $ENV{PERL5LIB}; + + } + elsif($ENV{PERLLIB}) + { + spacer; + diag "PERLLIB path"; + diag $_ for split $Config{path_sep}, $ENV{PERLLIB}; + } + + spacer; +} + +diag sprintf $format, 'perl', "$] $^O $Config{archname}"; + +foreach my $module (sort @modules) +{ + my $pm = "$module.pm"; + $pm =~ s{::}{/}g; + if(eval { require $pm; 1 }) + { + my $ver = eval { $module->VERSION }; + $ver = 'undef' unless defined $ver; + diag sprintf $format, $module, $ver; + } + else + { + diag sprintf $format, $module, '-'; + } +} + +if($post_diag) +{ + spacer; + $post_diag->(); +} + +spacer; + +done_testing; + diff --git a/t/io_async_open3_simple.t b/t/io_async_open3_simple.t index 02e70cb..37a5492 100644 --- a/t/io_async_open3_simple.t +++ b/t/io_async_open3_simple.t @@ -1,6 +1,33 @@ use Test2::V0 -no_srand => 1; +use 5.042; use IO::Async::Open3::Simple; -ok 1, 'todo'; +subtest 'create with list' => sub { + my $ipc = IO::Async::Open3::Simple->new( on_stdout => sub { }, ); + isa_ok $ipc, ['IO::Async::Open3::Simple'], 'isa IO::Async::Open3::Simple'; +}; + +subtest 'create with hashref' => sub { + my $ipc = IO::Async::Open3::Simple->new( + { + on_stdout => sub { }, + } + ); + isa_ok $ipc, ['IO::Async::Open3::Simple'], 'isa IO::Async::Open3::Simple'; +}; + +subtest 'stdin/raw no longer supported' => sub { + my $in = ''; + like( + dies { IO::Async::Open3::Simple->new( stdin => \$in ) }, + qr/stdin passed into IO::Async::Open3::Simple->new no longer supported/, + 'stdin dies', + ); + like( + dies { IO::Async::Open3::Simple->new( raw => 1 ) }, + qr/raw passed into IO::Async::Open3::Simple->new no longer supported/, + 'raw dies', + ); +}; done_testing; diff --git a/t/io_async_open3_simple__gh1.t b/t/io_async_open3_simple__gh1.t new file mode 100644 index 0000000..11add9a --- /dev/null +++ b/t/io_async_open3_simple__gh1.t @@ -0,0 +1,28 @@ +use Test2::V0 -no_srand => 1; +use 5.042; +use IO::Async::Loop; +use IO::Async::Open3::Simple; + +my $loop = IO::Async::Loop->new; + +foreach my $style ( + [ 'hashref' => sub { IO::Async::Open3::Simple->new( {@_} ) } ], + [ 'list' => sub { IO::Async::Open3::Simple->new(@_) } ], + ) +{ + my ( $name, $ctor ) = @$style; + subtest $name => sub { + my $done = $loop->new_future; + my $called_on_start = 0; + my $ipc = $ctor->( + on_start => sub { $called_on_start = 1 }, + on_exit => sub { $done->done }, + on_error => sub { $done->fail("on_error: $_[0]") }, + ); + $ipc->run( $^X, '-e', '42' ); + Future->wait_any( $done, $loop->timeout_future( after => 15 ) )->get; + is $called_on_start, 1, 'on_start was called'; + }; +} + +done_testing; diff --git a/t/io_async_open3_simple__on_error.t b/t/io_async_open3_simple__on_error.t new file mode 100644 index 0000000..2a9f7c5 --- /dev/null +++ b/t/io_async_open3_simple__on_error.t @@ -0,0 +1,38 @@ +use Test2::V0 -no_srand => 1; +use 5.042; +use IO::Async::Loop; +use IO::Async::Open3::Simple; +use File::Temp qw( tempdir ); +use File::Spec; + +plan skip_all => 'open3 does not die on missing program on MSWin32' if $^O eq 'MSWin32'; + +my $dir = tempdir( CLEANUP => 1 ); + +my $loop = IO::Async::Loop->new; +my $done = $loop->new_future; + +my $called_on_error = 0; +my ( $message, $cmd, @args ); + +my $ipc = IO::Async::Open3::Simple->new( + on_error => sub { + ( $message, $cmd, @args ) = @_; + $called_on_error = 1; + $done->done; + }, + on_exit => sub { $done->done }, +); + +my $bogus = File::Spec->catfile( $dir, 'bogus.pl' ); +$ipc->run( $bogus, 'arg1', 'arg2' ); + +Future->wait_any( $done, $loop->timeout_future( after => 15 ) )->get; + +is $called_on_error, 1, 'on_error was called'; +chomp $message; +like $message, qr/^open3: /, "message begins with open3: ($message)"; +is $cmd, $bogus, 'program passed to on_error'; +is \@args, [ 'arg1', 'arg2' ], 'arguments passed to on_error'; + +done_testing; diff --git a/t/io_async_open3_simple__on_error_mock.t b/t/io_async_open3_simple__on_error_mock.t new file mode 100644 index 0000000..615c7f6 --- /dev/null +++ b/t/io_async_open3_simple__on_error_mock.t @@ -0,0 +1,40 @@ +use Test2::V0 -no_srand => 1; +use 5.042; + +package IPC::Open3; + +BEGIN { $INC{'IPC/Open3.pm'} = __FILE__ } +use parent -norequire, 'Exporter'; +BEGIN { our @EXPORT_OK = 'open3' } + +sub open3 { die "open3: this is an error" } + +package main; + +use IO::Async::Loop; +use IO::Async::Open3::Simple; + +my $loop = IO::Async::Loop->new; +my $done = $loop->new_future; + +my $called_on_error = 0; +my $message = ''; + +my $ipc = IO::Async::Open3::Simple->new( + on_error => sub { + $message = shift; + $called_on_error = 1; + $done->done; + }, + on_exit => sub { $done->done }, +); + +$ipc->run( 'foo', 'bar' ); + +Future->wait_any( $done, $loop->timeout_future( after => 15 ) )->get; + +is $called_on_error, 1, 'on_error was called'; +chomp $message; +like $message, qr/^open3: /, "message begins with open3: ($message)"; + +done_testing; diff --git a/t/io_async_open3_simple__on_fail.t b/t/io_async_open3_simple__on_fail.t new file mode 100644 index 0000000..9f99e5c --- /dev/null +++ b/t/io_async_open3_simple__on_fail.t @@ -0,0 +1,48 @@ +use Test2::V0 -no_srand => 1; +use 5.042; +use IO::Async::Loop; +use IO::Async::Open3::Simple; +use File::Temp qw( tempdir ); +use File::Spec; + +my $dir = tempdir( CLEANUP => 1 ); +{ + open my $fh, '>', File::Spec->catfile( $dir, 'child_exit3.pl' ) or die $!; + print $fh "#!$^X\nexit 3\n"; + close $fh; + open $fh, '>', File::Spec->catfile( $dir, 'child_normal.pl' ) or die $!; + print $fh "#!$^X\n"; + close $fh; +} + +my $loop = IO::Async::Loop->new; + +my ( $proc, $signal, $exit_value1, $exit_value2, $done ); + +my $ipc = IO::Async::Open3::Simple->new( + on_fail => sub { ( $proc, $exit_value1 ) = @_ }, + on_exit => sub { ( $proc, $exit_value2, $signal ) = @_; $done->done }, + on_error => sub { $done->fail("on_error: $_[0]") }, +); + +subtest 'normal exit does not fire on_fail' => sub { + $done = $loop->new_future; + undef $exit_value1; + my $ret = $ipc->run( $^X, File::Spec->catfile( $dir, 'child_normal.pl' ) ); + isa_ok $ret, ['IO::Async::Open3::Simple'], 'run returns the ipc object'; + Future->wait_any( $done, $loop->timeout_future( after => 15 ) )->get; + is $exit_value1, undef, 'on_fail not called'; + is $exit_value2, 0, 'on_exit exit value 0'; +}; + +subtest 'non-zero exit fires on_fail' => sub { + $done = $loop->new_future; + undef $exit_value1; + my $ret = $ipc->run( $^X, File::Spec->catfile( $dir, 'child_exit3.pl' ) ); + isa_ok $ret, ['IO::Async::Open3::Simple'], 'run returns the ipc object'; + Future->wait_any( $done, $loop->timeout_future( after => 15 ) )->get; + is $exit_value1, 3, 'on_fail exit value 3'; + is $exit_value2, 3, 'on_exit exit value 3'; +}; + +done_testing; diff --git a/t/io_async_open3_simple__on_out.t b/t/io_async_open3_simple__on_out.t new file mode 100644 index 0000000..7f59e7b --- /dev/null +++ b/t/io_async_open3_simple__on_out.t @@ -0,0 +1,38 @@ +use Test2::V0 -no_srand => 1; +use 5.042; +use IO::Async::Loop; +use IO::Async::Open3::Simple; +use File::Temp qw( tempdir ); +use File::Spec; + +my $dir = tempdir( CLEANUP => 1 ); +{ + open my $fh, '>', File::Spec->catfile( $dir, 'child.pl' ) or die $!; + print $fh join "\n", "#!$^X", '$| = 1;', 'print "message1\n";', 'print "message2\n";', 'print STDERR "message3\n";'; + close $fh; +} + +my $loop = IO::Async::Loop->new; +my $done = $loop->new_future; + +my ( @out, @err, $proc, $exit_value, $signal ); + +my $ipc = IO::Async::Open3::Simple->new( + on_stdout => sub { push @out, $_[1] }, + on_stderr => sub { push @err, $_[1] }, + on_exit => sub { ( $proc, $exit_value, $signal ) = @_; $done->done }, + on_error => sub { $done->fail("on_error: $_[0]") }, +); + +my $ret = $ipc->run( $^X, File::Spec->catfile( $dir, 'child.pl' ) ); +isa_ok $ret, ['IO::Async::Open3::Simple'], 'run returns the ipc object'; + +Future->wait_any( $done, $loop->timeout_future( after => 15 ) )->get; + +is \@out, [ 'message1', 'message2' ], 'stdout lines'; +is \@err, ['message3'], 'stderr lines'; +isa_ok $proc, ['IO::Async::Open3::Simple::Process'], 'on_exit gets a process'; +is $exit_value, 0, 'exit value 0'; +is $signal, 0, 'signal 0'; + +done_testing; diff --git a/t/io_async_open3_simple__on_out_array.t b/t/io_async_open3_simple__on_out_array.t new file mode 100644 index 0000000..0405c49 --- /dev/null +++ b/t/io_async_open3_simple__on_out_array.t @@ -0,0 +1,35 @@ +use Test2::V0 -no_srand => 1; +use 5.042; +use IO::Async::Loop; +use IO::Async::Open3::Simple; +use File::Temp qw( tempdir ); +use File::Spec; + +my $dir = tempdir( CLEANUP => 1 ); +{ + open my $fh, '>', File::Spec->catfile( $dir, 'child.pl' ) or die $!; + print $fh join "\n", "#!$^X", '$| = 1;', 'print "message1\n";', 'print "message2\n";', 'print STDERR "message3\n";'; + close $fh; +} + +my $loop = IO::Async::Loop->new; +my $done = $loop->new_future; + +my ( @out, @err ); + +my $ipc = IO::Async::Open3::Simple->new( + on_stdout => \@out, + on_stderr => \@err, + on_exit => sub { $done->done }, + on_error => sub { $done->fail("on_error: $_[0]") }, +); + +my $ret = $ipc->run( $^X, File::Spec->catfile( $dir, 'child.pl' ) ); +isa_ok $ret, ['IO::Async::Open3::Simple'], 'run returns the ipc object'; + +Future->wait_any( $done, $loop->timeout_future( after => 15 ) )->get; + +is \@out, [ 'message1', 'message2' ], 'stdout lines pushed onto array ref'; +is \@err, ['message3'], 'stderr lines pushed onto array ref'; + +done_testing; diff --git a/t/io_async_open3_simple__on_signal.t b/t/io_async_open3_simple__on_signal.t new file mode 100644 index 0000000..1d8c7d1 --- /dev/null +++ b/t/io_async_open3_simple__on_signal.t @@ -0,0 +1,48 @@ +use Test2::V0 -no_srand => 1; +use 5.042; +use IO::Async::Loop; +use IO::Async::Open3::Simple; +use File::Temp qw( tempdir ); +use File::Spec; + +plan skip_all => 'on_signal not supported on MSWin32' if $^O eq 'MSWin32'; + +my $dir = tempdir( CLEANUP => 1 ); +{ + open my $fh, '>', File::Spec->catfile( $dir, 'child_sig9.pl' ) or die $!; + print $fh "#!$^X\nkill 9, \$\$\n"; + close $fh; + open $fh, '>', File::Spec->catfile( $dir, 'child_normal.pl' ) or die $!; + print $fh "#!$^X\n"; + close $fh; +} + +my $loop = IO::Async::Loop->new; + +my ( $proc, $signal1, $signal2, $exit_value, $done ); + +my $ipc = IO::Async::Open3::Simple->new( + on_signal => sub { ( $proc, $signal1 ) = @_ }, + on_exit => sub { ( $proc, $exit_value, $signal2 ) = @_; $done->done }, + on_error => sub { $done->fail("on_error: $_[0]") }, +); + +subtest 'normal exit does not fire on_signal' => sub { + $done = $loop->new_future; + undef $signal1; + $ipc->run( $^X, File::Spec->catfile( $dir, 'child_normal.pl' ) ); + Future->wait_any( $done, $loop->timeout_future( after => 15 ) )->get; + is $signal1, undef, 'on_signal not called'; + is $signal2, 0, 'on_exit signal 0'; +}; + +subtest 'killed by signal fires on_signal' => sub { + $done = $loop->new_future; + undef $signal1; + $ipc->run( $^X, File::Spec->catfile( $dir, 'child_sig9.pl' ) ); + Future->wait_any( $done, $loop->timeout_future( after => 15 ) )->get; + is $signal1, 9, 'on_signal signal 9'; + is $signal2, 9, 'on_exit signal 9'; +}; + +done_testing; diff --git a/t/io_async_open3_simple__on_start.t b/t/io_async_open3_simple__on_start.t new file mode 100644 index 0000000..812b356 --- /dev/null +++ b/t/io_async_open3_simple__on_start.t @@ -0,0 +1,53 @@ +use Test2::V0 -no_srand => 1; +use 5.042; +use IO::Async::Loop; +use IO::Async::Open3::Simple; +use File::Temp qw( tempdir ); +use File::Spec; + +my $dir = tempdir( CLEANUP => 1 ); +{ + open my $fh, '>', File::Spec->catfile( $dir, 'child.pl' ) or die $!; + print $fh "#!$^X\n"; + close $fh; +} + +my $loop = IO::Async::Loop->new; + +my ( $proc, $prog, @args ); +my $on_start_called = 0; +my $done; + +my $ipc = IO::Async::Open3::Simple->new( + on_start => sub { + ( $proc, $prog, @args ) = @_; + $on_start_called++; + }, + on_exit => sub { $done->done }, + on_error => sub { $done->fail("on_error: $_[0]") }, +); + +my $child = File::Spec->catfile( $dir, 'child.pl' ); + +foreach my $iteration ( 1 .. 2 ) { + subtest "iteration $iteration" => sub { + $done = $loop->new_future; + $on_start_called = 0; + + my $foo = 0; + my @cb_args; + + my $ret = $ipc->run( $^X, $child, 'arg1', 'arg2', sub { $foo = $iteration; @cb_args = @_ } ); + isa_ok $ret, ['IO::Async::Open3::Simple'], 'run returns the ipc object'; + + Future->wait_any( $done, $loop->timeout_future( after => 15 ) )->get; + + is $on_start_called, 1, 'on_start fired once'; + is $prog, $^X, 'program passed to on_start'; + is \@args, [ $child, 'arg1', 'arg2' ], 'arguments passed to on_start'; + is [ map { ref } @cb_args ], ['IO::Async::Open3::Simple::Process'], 'run callback gets a single process object'; + is $foo, $iteration, "run callback ran (foo == $iteration)"; + }; +} + +done_testing; diff --git a/t/io_async_open3_simple__on_success.t b/t/io_async_open3_simple__on_success.t new file mode 100644 index 0000000..b96ddb9 --- /dev/null +++ b/t/io_async_open3_simple__on_success.t @@ -0,0 +1,46 @@ +use Test2::V0 -no_srand => 1; +use 5.042; +use IO::Async::Loop; +use IO::Async::Open3::Simple; +use File::Temp qw( tempdir ); +use File::Spec; + +my $dir = tempdir( CLEANUP => 1 ); +{ + open my $fh, '>', File::Spec->catfile( $dir, 'child_exit3.pl' ) or die $!; + print $fh "#!$^X\nexit 3\n"; + close $fh; + open $fh, '>', File::Spec->catfile( $dir, 'child_normal.pl' ) or die $!; + print $fh "#!$^X\n"; + close $fh; +} + +my $loop = IO::Async::Loop->new; + +my ( $proc, $signal, $success, $exit_value, $done ); + +my $ipc = IO::Async::Open3::Simple->new( + on_success => sub { $success = 1 }, + on_exit => sub { ( $proc, $exit_value, $signal ) = @_; $done->done }, + on_error => sub { $done->fail("on_error: $_[0]") }, +); + +subtest 'zero exit fires on_success' => sub { + $done = $loop->new_future; + undef $success; + $ipc->run( $^X, File::Spec->catfile( $dir, 'child_normal.pl' ) ); + Future->wait_any( $done, $loop->timeout_future( after => 15 ) )->get; + is $success, 1, 'on_success called'; + is $exit_value, 0, 'exit value 0'; +}; + +subtest 'non-zero exit does not fire on_success' => sub { + $done = $loop->new_future; + undef $success; + $ipc->run( $^X, File::Spec->catfile( $dir, 'child_exit3.pl' ) ); + Future->wait_any( $done, $loop->timeout_future( after => 15 ) )->get; + is $success, undef, 'on_success not called'; + is $exit_value, 3, 'exit value 3'; +}; + +done_testing; diff --git a/t/io_async_open3_simple__print.t b/t/io_async_open3_simple__print.t new file mode 100644 index 0000000..9a740fb --- /dev/null +++ b/t/io_async_open3_simple__print.t @@ -0,0 +1,45 @@ +use Test2::V0 -no_srand => 1; +use 5.042; +use IO::Async::Loop; +use IO::Async::Open3::Simple; +use File::Temp qw( tempdir ); +use File::Spec; + +plan skip_all => 'print not supported on MSWin32' if $^O eq 'MSWin32'; + +my $dir = tempdir( CLEANUP => 1 ); +{ + open my $fh, '>', File::Spec->catfile( $dir, 'child.pl' ) or die $!; + print $fh join "\n", "#!$^X", + 'use File::Spec;', + "open(my \$out, '>', File::Spec->catfile('$dir', 'child.out'));", + 'while() { print $out $_ }'; + close $fh; +} + +my $loop = IO::Async::Loop->new; +my $done = $loop->new_future; + +my $ipc = IO::Async::Open3::Simple->new( + on_start => sub { + my ($proc) = @_; + $proc->say('message1'); + $proc->say('message2'); + $proc->close; + }, + on_exit => sub { $done->done }, + on_error => sub { $done->fail("on_error: $_[0]") }, +); + +my $ret = $ipc->run( $^X, File::Spec->catfile( $dir, 'child.pl' ) ); +isa_ok $ret, ['IO::Async::Open3::Simple'], 'run returns the ipc object'; + +Future->wait_any( $done, $loop->timeout_future( after => 15 ) )->get; + +open my $fh, '<', File::Spec->catfile( $dir, 'child.out' ) or die $!; +chomp( my @list = <$fh> ); +close $fh; + +is \@list, [ 'message1', 'message2' ], 'child received data written via $proc->say'; + +done_testing; diff --git a/t/io_async_open3_simple__proc.t b/t/io_async_open3_simple__proc.t new file mode 100644 index 0000000..e3f411f --- /dev/null +++ b/t/io_async_open3_simple__proc.t @@ -0,0 +1,43 @@ +use Test2::V0 -no_srand => 1; +use 5.042; +use IO::Async::Loop; +use IO::Async::Open3::Simple; +use File::Temp qw( tempdir ); +use File::Spec; + +my $dir = tempdir( CLEANUP => 1 ); +{ + open my $fh, '>', File::Spec->catfile( $dir, 'child.pl' ) or die $!; + print $fh "#!$^X\n"; + close $fh; +} + +my $loop = IO::Async::Loop->new; +my $done = $loop->new_future; + +my ( $start_proc, $exit_proc, $child_pid, $old_user, $new_user ); + +my $ipc = IO::Async::Open3::Simple->new( + on_start => sub { ($start_proc) = @_ }, + on_exit => sub { + ($exit_proc) = @_; + $child_pid = $exit_proc->pid; + $old_user = $exit_proc->user; + $exit_proc->user('some user data'); + $done->done; + }, + on_error => sub { $done->fail("on_error: $_[0]") }, +); + +my $ret = $ipc->run( $^X, File::Spec->catfile( $dir, 'child.pl' ) ); +isa_ok $ret, ['IO::Async::Open3::Simple'], 'run returns the ipc object'; + +Future->wait_any( $done, $loop->timeout_future( after => 15 ) )->get; + +like $child_pid, qr/^[0-9]+$/, "proc->pid is numeric ($child_pid)"; +is $start_proc->pid, $child_pid, 'on_start and on_exit see the same process'; +ref_is $start_proc, $exit_proc, 'on_start and on_exit get the same object'; +is $old_user, '', 'user starts empty'; +is $new_user = $exit_proc->user, 'some user data', 'user was updated'; + +done_testing; diff --git a/t/io_async_open3_simple__process.t b/t/io_async_open3_simple__process.t new file mode 100644 index 0000000..6851009 --- /dev/null +++ b/t/io_async_open3_simple__process.t @@ -0,0 +1,16 @@ +use Test2::V0 -no_srand => 1; +use 5.042; +use IO::Async::Open3::Simple::Process; + +my $proc = do { + no warnings 'once'; + IO::Async::Open3::Simple::Process->new( 42, \*foo ); +}; +isa_ok $proc, ['IO::Async::Open3::Simple::Process'], 'isa Process'; +is $proc->pid, 42, 'pid'; + +is $proc->user, '', 'user defaults to empty string'; +$proc->user( { answer => 42 } ); +is $proc->user, { answer => 42 }, 'user round trips'; + +done_testing; diff --git a/t/io_async_open3_simple__run_no_args.t b/t/io_async_open3_simple__run_no_args.t new file mode 100644 index 0000000..061d81f --- /dev/null +++ b/t/io_async_open3_simple__run_no_args.t @@ -0,0 +1,10 @@ +use Test2::V0 -no_srand => 1; +use 5.042; +use IO::Async::Open3::Simple; + +my $ipc = IO::Async::Open3::Simple->new; +isa_ok $ipc, ['IO::Async::Open3::Simple'], 'isa IO::Async::Open3::Simple'; + +like( dies { $ipc->run }, qr/run method requires at least one argument/, 'run with no arguments dies', ); + +done_testing; diff --git a/t/io_async_open3_simple__stdin.t b/t/io_async_open3_simple__stdin.t new file mode 100644 index 0000000..87e38a1 --- /dev/null +++ b/t/io_async_open3_simple__stdin.t @@ -0,0 +1,45 @@ +use Test2::V0 -no_srand => 1; +use 5.042; +use IO::Async::Loop; +use IO::Async::Open3::Simple; +use File::Temp qw( tempdir ); +use File::Spec; + +my $dir = tempdir( CLEANUP => 1 ); +{ + open my $fh, '>', File::Spec->catfile( $dir, 'child.pl' ) or die $!; + print $fh "#!$^X\n"; + print $fh 'use File::Spec;', "\n"; + print $fh "open(my \$out, '>', File::Spec->catfile('$dir', 'child.out'));", "\n"; + print $fh 'while() { print $out $_ }', "\n"; + close $fh; +} + +my $loop = IO::Async::Loop->new; +my $child = File::Spec->catfile( $dir, 'child.pl' ); +my $outfile = File::Spec->catfile( $dir, 'child.out' ); + +foreach my $stdin ( [qw( message1 message2 )], join( "\n", qw( message1 message2 ) ) ) { + subtest 'stdin as ' . ( ref $stdin ? 'array ref' : 'scalar ref' ) => sub { + unlink $outfile; + my $done = $loop->new_future; + + my $ipc = IO::Async::Open3::Simple->new( + on_exit => sub { $done->done }, + on_error => sub { $done->fail("on_error: $_[0]") }, + ); + + my $ret = $ipc->run( $^X, $child, ref $stdin ? $stdin : \$stdin ); + isa_ok $ret, ['IO::Async::Open3::Simple'], 'run returns the ipc object'; + + Future->wait_any( $done, $loop->timeout_future( after => 15 ) )->get; + + open my $fh, '<', $outfile or die $!; + chomp( my @list = <$fh> ); + close $fh; + + is \@list, [ 'message1', 'message2' ], 'child received stdin'; + }; +} + +done_testing; diff --git a/xt/author/critic.t b/xt/author/critic.t index c2073b1..53da5b6 100644 --- a/xt/author/critic.t +++ b/xt/author/critic.t @@ -5,10 +5,8 @@ use Test2::V0; use Perl::Critic; use Test2::Tools::PerlCritic; -my $critic = Perl::Critic->new( - -profile => 'perlcriticrc', -); +my $critic = Perl::Critic->new( -profile => 'perlcriticrc', ); -perl_critic_ok ['lib','t'], $critic; +perl_critic_ok [ 'lib', 't' ], $critic; done_testing;