File Coverage

blib/lib/Future/IO/System.pm
Criterion Covered Total %
statement 55 55 100.0
branch 21 24 87.5
condition 3 9 33.3
subroutine 8 8 100.0
pod 3 3 100.0
total 90 99 90.9


line stmt bran cond sub pod time code
1             # You may distribute under the terms of either the GNU General Public License
2             # or the Artistic License (the same terms as Perl itself)
3             #
4             # (C) Paul Evans, 2023-2026 -- leonerd@leonerd.org.uk
5              
6             package Future::IO::System 0.22;
7              
8 5     5   3985 use v5.14;
  5         25  
9 5     5   40 use warnings;
  5         10  
  5         300  
10              
11 5     5   35 use Carp;
  5         10  
  5         335  
12              
13 5     5   35 use Future::IO;
  5         10  
  5         4005  
14              
15             =head1 NAME
16              
17             C - C-like methods for L
18              
19             =head1 SYNOPSIS
20              
21             =for highlighter language=perl
22              
23             use Future::IO;
24             use Future::IO::System;
25              
26             my $f = Future::IO::System->system( "cmd", "args go", "here" );
27             # $f will become done when the command completes
28              
29             my $f = Future::IO::System->system_out( "cmd", "-v" );
30             my ( $status, $out ) = $f->get;
31              
32             # $status will contain the exit code and $out will contain what it wrote
33             # to STDOUT
34              
35             =head1 DESCRIPTION
36              
37             This package contains a selection of methods that behave like the core
38             C and related functions, running asynchronously via L.
39              
40             In particular, the L behaves somewhat like C and
41             L behaves somewhat like L.
42              
43             =head2 Portability
44              
45             In order for this module to work at all, the underlying C
46             implementation must support the L method. The default
47             minimal implementation included with the module does not, but most of the
48             additional implementations from CPAN will.
49              
50             In addition, the operation of this module uses techniques that only really
51             work on full POSIX systems (such as Linux, Mac OS X, the various BSDs, etc).
52             It is unlikely to work in places like MSWin32.
53              
54             =cut
55              
56             # TODO: Print at least some sort of warning if loaded on one of the weird
57             # non-POSIX OSes
58              
59             =head1 METHODS
60              
61             =cut
62              
63             =head2 run
64              
65             ( $exitcode, ... ) = await Future::IO::System->run(
66             argv => [ $path, @args ],
67             ...
68             );
69              
70             I
71              
72             Runs the given C<$path> with the given C<@args> as a sub-process, optionally
73             with some additional filehandles set up as determined by the other arguments.
74             The returned L will yield the C exit code from the process
75             when it terminates, and optionally the bytes read from the other filehandles
76             that were set up.
77              
78             Takes the following named arguments
79              
80             =over 4
81              
82             =item argv => ARRAY
83              
84             An array reference containing the path and arguments to pass to C in
85             the child process.
86              
87             =item in => STRING
88              
89             If defined, create a pipe and assign the reading end to the child process's
90             STDIN filehandle. The given string will then be written to the pipe, after
91             which the pipe will be closed.
92              
93             =item want_out => BOOL
94              
95             If true, create a pipe and assign the writing end to the child process's
96             STDOUT filehandle. The returned future will additionally contain all the bytes
97             read from it until EOF.
98              
99             =item want_err => BOOL
100              
101             If true, create a pipe and assign the writing end to the child process's
102             STDERR filehandle. The returned future will additionally contain all the bytes
103             read from it until EOF.
104              
105             =back
106              
107             The remaining methods in this class are simplified wrappers of this one.
108              
109             =cut
110              
111             sub run
112             {
113 14     14 1 12279 shift;
114 14         97 my %params = @_;
115              
116 14         379 require POSIX;
117              
118 14         74 my $argv = $params{argv};
119 14         43 my $want_in = defined $params{in};
120 14         52 my $want_out = $params{want_out};
121 14         31 my $want_err = $params{want_err};
122              
123 14         52 my @infh;
124 14 100 33     401 pipe( $infh[0], $infh[1] ) or croak "Cannot pipe() - $!"
125             if $want_in;
126              
127 14         31 my @outfh;
128 14 100 33     362 pipe( $outfh[0], $outfh[1] ) or croak "Cannot pipe() - $!"
129             if $want_out;
130              
131 14         45 my @errfh;
132 14 100 33     174 pipe( $errfh[0], $errfh[1] ) or croak "Cannot pipe() - $!"
133             if $want_err;
134              
135 14 50       36419 defined( my $pid = fork() )
136             or croak "Cannot fork() - $!";
137              
138 14 100       860 if( $pid ) {
139             # parent
140              
141 10         158 my @f;
142 10         1199 push @f, Future::IO->waitpid( $pid );
143              
144 10 100       127188 if( $want_in ) {
145 2         70 close $infh[0];
146             push @f, Future::IO->syswrite_exactly( $infh[1], $params{in} )
147 2     2   90 ->then( sub { Future->done() } );
  2         458  
148             }
149              
150 10 100       660 if( $want_out ) {
151 6         161 close $outfh[1];
152 6         147 push @f, Future::IO->read_until_eof( $outfh[0] );
153             }
154              
155 10 100       999 if( $want_err ) {
156 1         18 close $errfh[1];
157 1         35 push @f, Future::IO->read_until_eof( $errfh[0] );
158             }
159              
160 10         629 return Future->needs_all( @f );
161             }
162             else {
163             # child
164              
165 4 100       530 if( $want_in ) {
166 1         90 close $infh[1];
167 1         163 POSIX::dup2( $infh[0]->fileno, 0 );
168             }
169              
170 4 100       507 if( $want_out ) {
171 3         232 close $outfh[0];
172 3         266 POSIX::dup2( $outfh[1]->fileno, 1 );
173             }
174              
175 4 100       301 if( $want_err ) {
176 1         32 close $errfh[0];
177 1         32 POSIX::dup2( $errfh[1]->fileno, 2 );
178             }
179              
180 4 0       0 exec( @$argv ) or
181             POSIX::_exit( -1 );
182             }
183             }
184              
185             =head2 system
186              
187             $exitcode = await Future::IO::System->system( $path, @args );
188              
189             I
190              
191             Runs the given C<$path> with the given C<@args> as a sub-process with no extra
192             filehandles.
193              
194             =cut
195              
196             sub system
197             {
198 5     5 1 240 my $self = shift;
199 5         30 my @argv = @_;
200              
201 5         30 return $self->run( argv => \@argv );
202             }
203              
204             =head2 system_out
205              
206             ( $exitcode, $out ) = await Future::IO::System->system_out( $path, @args );
207              
208             I
209              
210             Runs the given C<$path> with the given C<@args> as a sub-process with a new
211             pipe as its STDOUT filehandle. The returned L will additionally yield
212             the bytes read from the STDOUT pipe.
213              
214             =cut
215              
216             sub system_out
217             {
218 4     4 1 4202640 my $self = shift;
219 4         32 my @argv = @_;
220              
221 4         28 return $self->run( argv => \@argv, want_out => 1 );
222             }
223              
224             =head1 TODO
225              
226             =over 4
227              
228             =item *
229              
230             Add some OS portability guard warnings when loading the module on platforms
231             not known to support it.
232              
233             =item *
234              
235             Consider what other features of modules like L or
236             L to support here. Try not to go overboard.
237              
238             =back
239              
240             =cut
241              
242             =head1 AUTHOR
243              
244             Paul Evans
245              
246             =cut
247              
248             0x55AA;