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.14; |
7
|
|
|
|
|
|
|
|
8
|
1
|
|
|
1
|
|
474
|
use v5.14; |
|
1
|
|
|
|
|
20
|
|
9
|
1
|
|
|
1
|
|
5
|
use warnings; |
|
1
|
|
|
|
|
10
|
|
|
1
|
|
|
|
|
38
|
|
10
|
|
|
|
|
|
|
|
11
|
1
|
|
|
1
|
|
7
|
use Carp; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
443
|
|
12
|
|
|
|
|
|
|
|
13
|
1
|
|
|
1
|
|
6
|
use Future::IO; |
|
1
|
|
|
|
|
3
|
|
|
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; |