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.23;
7              
8 5     5   3775 use v5.14;
  5         20  
9 5     5   30 use warnings;
  5         15  
  5         265  
10              
11 5     5   30 use Carp;
  5         10  
  5         430  
12              
13 5     5   40 use Future::IO;
  5         10  
  5         4120  
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 8792 shift;
114 14         132 my %params = @_;
115              
116 14         153 require POSIX;
117              
118 14         34 my $argv = $params{argv};
119 14         32 my $want_in = defined $params{in};
120 14         32 my $want_out = $params{want_out};
121 14         65 my $want_err = $params{want_err};
122              
123 14         27 my @infh;
124 14 100 33     173 pipe( $infh[0], $infh[1] ) or croak "Cannot pipe() - $!"
125             if $want_in;
126              
127 14         23 my @outfh;
128 14 100 33     399 pipe( $outfh[0], $outfh[1] ) or croak "Cannot pipe() - $!"
129             if $want_out;
130              
131 14         32 my @errfh;
132 14 100 33     72 pipe( $errfh[0], $errfh[1] ) or croak "Cannot pipe() - $!"
133             if $want_err;
134              
135 14 50       36484 defined( my $pid = fork() )
136             or croak "Cannot fork() - $!";
137              
138 14 100       759 if( $pid ) {
139             # parent
140              
141 10         93 my @f;
142 10         1205 push @f, Future::IO->waitpid( $pid );
143              
144 10 100       4874 if( $want_in ) {
145 2         140 close $infh[0];
146             push @f, Future::IO->syswrite_exactly( $infh[1], $params{in} )
147 2     2   102 ->then( sub { Future->done() } );
  2         190  
148             }
149              
150 10 100       1933 if( $want_out ) {
151 6         243 close $outfh[1];
152 6         286 push @f, Future::IO->read_until_eof( $outfh[0] );
153             }
154              
155 10 100       1028 if( $want_err ) {
156 1         20 close $errfh[1];
157 1         1046 push @f, Future::IO->read_until_eof( $errfh[0] );
158             }
159              
160 10         899 return Future->needs_all( @f );
161             }
162             else {
163             # child
164              
165 4 100       556 if( $want_in ) {
166 1         114 close $infh[1];
167 1         105 POSIX::dup2( $infh[0]->fileno, 0 );
168             }
169              
170 4 100       301 if( $want_out ) {
171 3         208 close $outfh[0];
172 3         421 POSIX::dup2( $outfh[1]->fileno, 1 );
173             }
174              
175 4 100       259 if( $want_err ) {
176 1         19 close $errfh[0];
177 1         22 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 6990 my $self = shift;
199 5         20 my @argv = @_;
200              
201 5         15 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 5228512 my $self = shift;
219 4         60 my @argv = @_;
220              
221 4         44 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;