File Coverage

blib/lib/Future/IO/System.pm
Criterion Covered Total %
statement 11 55 20.0
branch 0 24 0.0
condition 0 9 0.0
subroutine 4 8 50.0
pod 3 3 100.0
total 18 99 18.1


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