line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package IPC::PrettyPipe::Stream; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
# ABSTRACT: An I/O stream for an B pipeline or command |
4
|
|
|
|
|
|
|
|
5
|
18
|
|
|
18
|
|
233142
|
use Carp; |
|
18
|
|
|
|
|
49
|
|
|
18
|
|
|
|
|
1305
|
|
6
|
|
|
|
|
|
|
|
7
|
18
|
|
|
18
|
|
707
|
use Types::Standard qw[ Bool Str ]; |
|
18
|
|
|
|
|
75496
|
|
|
18
|
|
|
|
|
185
|
|
8
|
|
|
|
|
|
|
|
9
|
18
|
|
|
18
|
|
22624
|
use IPC::PrettyPipe::Stream::Utils qw[ parse_spec ]; |
|
18
|
|
|
|
|
54
|
|
|
18
|
|
|
|
|
1458
|
|
10
|
|
|
|
|
|
|
|
11
|
18
|
|
|
18
|
|
608
|
use String::ShellQuote 'shell_quote'; |
|
18
|
|
|
|
|
1036
|
|
|
18
|
|
|
|
|
886
|
|
12
|
18
|
|
|
18
|
|
8785
|
use IO::ReStoreFH; |
|
18
|
|
|
|
|
268917
|
|
|
18
|
|
|
|
|
657
|
|
13
|
18
|
|
|
18
|
|
174
|
use POSIX (); |
|
18
|
|
|
|
|
41
|
|
|
18
|
|
|
|
|
448
|
|
14
|
18
|
|
|
18
|
|
94
|
use Fcntl qw[ O_RDONLY O_WRONLY O_CREAT O_TRUNC O_APPEND ]; |
|
18
|
|
|
|
|
47
|
|
|
18
|
|
|
|
|
1073
|
|
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
|
17
|
18
|
|
|
18
|
|
694
|
use Moo; |
|
18
|
|
|
|
|
11298
|
|
|
18
|
|
|
|
|
156
|
|
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
our $VERSION = '0.13'; |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
with 'IPC::PrettyPipe::Queue::Element'; |
23
|
|
|
|
|
|
|
|
24
|
18
|
|
|
18
|
|
8853
|
use namespace::clean; |
|
18
|
|
|
|
|
9871
|
|
|
18
|
|
|
|
|
161
|
|
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
my %fh_map = ( |
28
|
|
|
|
|
|
|
0 => *STDIN, |
29
|
|
|
|
|
|
|
1 => *STDOUT, |
30
|
|
|
|
|
|
|
2 => *STDERR |
31
|
|
|
|
|
|
|
); |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
my %op_map = ( |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
'<' => O_RDONLY, |
36
|
|
|
|
|
|
|
'>' => O_WRONLY | O_CREAT | O_TRUNC, |
37
|
|
|
|
|
|
|
'>>' => O_WRONLY | O_CREAT | O_APPEND |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
); |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
has N => ( |
42
|
|
|
|
|
|
|
is => 'rwp', |
43
|
|
|
|
|
|
|
predicate => 1, |
44
|
|
|
|
|
|
|
init_arg => undef, |
45
|
|
|
|
|
|
|
); |
46
|
|
|
|
|
|
|
has M => ( |
47
|
|
|
|
|
|
|
is => 'rwp', |
48
|
|
|
|
|
|
|
predicate => 1, |
49
|
|
|
|
|
|
|
init_arg => undef, |
50
|
|
|
|
|
|
|
); |
51
|
|
|
|
|
|
|
has Op => ( |
52
|
|
|
|
|
|
|
is => 'rwp', |
53
|
|
|
|
|
|
|
init_arg => undef, |
54
|
|
|
|
|
|
|
); |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
has spec => ( |
57
|
|
|
|
|
|
|
is => 'rwp', |
58
|
|
|
|
|
|
|
isa => Str, |
59
|
|
|
|
|
|
|
required => 1, |
60
|
|
|
|
|
|
|
); |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
has file => ( |
63
|
|
|
|
|
|
|
is => 'rw', |
64
|
|
|
|
|
|
|
isa => Str, |
65
|
|
|
|
|
|
|
predicate => 1, |
66
|
|
|
|
|
|
|
); |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
has _type => ( |
69
|
|
|
|
|
|
|
is => 'rwp', |
70
|
|
|
|
|
|
|
isa => Str, |
71
|
|
|
|
|
|
|
init_arg => undef, |
72
|
|
|
|
|
|
|
); |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
has requires_file => ( |
75
|
|
|
|
|
|
|
is => 'rwp', |
76
|
|
|
|
|
|
|
init_arg => undef, |
77
|
|
|
|
|
|
|
); |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
has strict => ( |
80
|
|
|
|
|
|
|
is => 'ro', |
81
|
|
|
|
|
|
|
isa => Bool, |
82
|
|
|
|
|
|
|
default => sub { 1 } ); |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
sub BUILDARGS { |
89
|
|
|
|
|
|
|
|
90
|
205
|
|
|
205
|
0
|
39214
|
my $class = shift; |
91
|
|
|
|
|
|
|
|
92
|
205
|
100
|
|
|
|
631
|
if ( @_ == 1 ) { |
93
|
|
|
|
|
|
|
|
94
|
3
|
50
|
|
|
|
9
|
return $_[0] if 'HASH' eq ref( $_[0] ); |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
return { spec => $_[0][0], file => $_[0][1] } |
97
|
3
|
50
|
33
|
|
|
10
|
if 'ARRAY' eq ref( $_[0] ) && @{ $_[0] } == 2; |
|
0
|
|
|
|
|
0
|
|
98
|
|
|
|
|
|
|
|
99
|
3
|
|
|
|
|
54
|
return { spec => $_[0] }; |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
} |
102
|
|
|
|
|
|
|
|
103
|
202
|
|
|
|
|
3552
|
return {@_}; |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
} |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
sub BUILD { |
108
|
|
|
|
|
|
|
|
109
|
205
|
|
|
205
|
0
|
9780
|
my $self = shift; |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
## no critic (ProhibitAccessOfPrivateData) |
112
|
|
|
|
|
|
|
|
113
|
205
|
|
|
|
|
1099
|
my $opc = parse_spec( $self->spec ); |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
croak( __PACKAGE__, ': ', "cannot parse stream specification: ", |
116
|
|
|
|
|
|
|
$self->spec ) |
117
|
205
|
100
|
|
|
|
24399
|
unless defined $opc->{type}; |
118
|
|
|
|
|
|
|
|
119
|
72
|
|
|
|
|
276
|
$self->_set_requires_file( $opc->{param} ); |
120
|
72
|
|
|
|
|
1583
|
$self->_set__type( $opc->{type} ); |
121
|
|
|
|
|
|
|
|
122
|
146
|
|
|
|
|
755
|
$self->${ \"_set_$_" }( $opc->{$_} ) |
123
|
72
|
|
|
|
|
2340
|
for grep { exists $opc->{$_} } qw[ N M Op ]; |
|
216
|
|
|
|
|
567
|
|
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
|
126
|
72
|
100
|
|
|
|
283
|
if ( $self->strict ) { |
127
|
|
|
|
|
|
|
|
128
|
4
|
100
|
66
|
|
|
336
|
croak( __PACKAGE__, ': ', "stream specification ", |
129
|
|
|
|
|
|
|
$self->spec, "requires a file\n" ) |
130
|
|
|
|
|
|
|
if $self->requires_file && !$self->has_file; |
131
|
|
|
|
|
|
|
|
132
|
2
|
50
|
33
|
|
|
14
|
croak( __PACKAGE__, ': ', "stream specification ", |
133
|
|
|
|
|
|
|
$self->spec, "should not have a file\n" ) |
134
|
|
|
|
|
|
|
if !$self->requires_file && $self->has_file; |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
} |
137
|
|
|
|
|
|
|
|
138
|
70
|
|
|
|
|
379
|
return; |
139
|
|
|
|
|
|
|
} |
140
|
|
|
|
|
|
|
|
141
|
25
|
|
|
25
|
1
|
9880
|
sub quoted_file { shell_quote( $_[0]->file ) } |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
sub _redirect { |
144
|
|
|
|
|
|
|
|
145
|
4
|
|
|
4
|
|
16
|
my ( $self, $N ) = @_; |
146
|
|
|
|
|
|
|
|
147
|
4
|
|
|
|
|
93
|
my $file = $self->file; |
148
|
|
|
|
|
|
|
|
149
|
4
|
|
|
|
|
32
|
my $sub; |
150
|
|
|
|
|
|
|
|
151
|
4
|
50
|
|
|
|
14
|
if ( defined $N ) { |
152
|
|
|
|
|
|
|
|
153
|
4
|
|
|
|
|
22
|
my $op = $self->Op; |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
$sub = sub { |
156
|
4
|
50
|
|
4
|
|
395
|
open( $N, $op, $file ) or die( "unable to open ", $file, ": $!\n" ); |
157
|
4
|
|
|
|
|
50
|
}; |
158
|
|
|
|
|
|
|
} |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
else { |
161
|
|
|
|
|
|
|
|
162
|
0
|
|
|
|
|
0
|
$N = $self->N; |
163
|
0
|
|
0
|
|
|
0
|
my $op = $op_map{ $self->Op } |
164
|
|
|
|
|
|
|
// croak( "error: unrecognized operator: ", $self->Op, "\n" ); |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
$sub = sub { |
167
|
0
|
0
|
|
0
|
|
0
|
my $nfd = POSIX::open( $file, $op, oct( 644 ) ) |
168
|
|
|
|
|
|
|
or croak( 'error opening', $file, ": $!\n" ); |
169
|
0
|
0
|
|
|
|
0
|
POSIX::dup2( $nfd, $N ) |
170
|
|
|
|
|
|
|
or croak( "error in dup2( $nfd, $N ): $!\n" ); |
171
|
0
|
|
|
|
|
0
|
POSIX::close( $nfd ); |
172
|
0
|
|
|
|
|
0
|
}; |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
} |
175
|
|
|
|
|
|
|
|
176
|
4
|
|
|
|
|
27
|
return $sub, $N; |
177
|
|
|
|
|
|
|
} |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
sub _dup { |
180
|
|
|
|
|
|
|
|
181
|
0
|
|
|
0
|
|
0
|
my ( $self, $N, $M ) = @_; |
182
|
|
|
|
|
|
|
|
183
|
0
|
|
0
|
|
|
0
|
$M //= $self->M; |
184
|
|
|
|
|
|
|
|
185
|
0
|
|
|
|
|
0
|
my $sub; |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
# if $N is a known filehandle, we're in luck |
188
|
0
|
0
|
|
|
|
0
|
if ( defined $N ) { |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
$sub = sub { |
191
|
0
|
0
|
|
0
|
|
0
|
open( $N, '>&', $M ) |
192
|
|
|
|
|
|
|
or die( "error in open($N >& $M): $!\n" ); |
193
|
0
|
|
|
|
|
0
|
}; |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
} |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
else { |
198
|
|
|
|
|
|
|
|
199
|
0
|
|
|
|
|
0
|
$N = $self->N; |
200
|
0
|
|
|
|
|
0
|
$M = $self->M; |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
$sub = sub { |
203
|
0
|
0
|
|
0
|
|
0
|
POSIX::dup2( $N, $M ) |
204
|
|
|
|
|
|
|
or die( "error in dup2( $N, $M ): $!\n" ); |
205
|
0
|
|
|
|
|
0
|
}; |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
} |
208
|
|
|
|
|
|
|
|
209
|
0
|
|
|
|
|
0
|
return $sub, $N; |
210
|
|
|
|
|
|
|
} |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
sub _redirect_stdout_stderr { |
213
|
|
|
|
|
|
|
|
214
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
215
|
|
|
|
|
|
|
|
216
|
0
|
|
|
|
|
0
|
( undef, my $sub_redir ) = $self->_redirect( *STDOUT ); |
217
|
0
|
|
|
|
|
0
|
( undef, my $sub_dup ) = $self->_dup( *STDERR, *STDOUT ); |
218
|
0
|
|
|
0
|
|
0
|
return sub { $sub_redir->(), $sub_dup->() }, *STDOUT, *STDERR; |
|
0
|
|
|
|
|
0
|
|
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
} |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
sub _close { |
223
|
|
|
|
|
|
|
|
224
|
0
|
|
|
0
|
|
0
|
my ( $self, $N ) = @_; |
225
|
|
|
|
|
|
|
|
226
|
0
|
|
|
|
|
0
|
my $sub; |
227
|
|
|
|
|
|
|
|
228
|
0
|
0
|
|
|
|
0
|
if ( defined $N ) { |
229
|
|
|
|
|
|
|
|
230
|
0
|
0
|
|
0
|
|
0
|
$sub = sub { close( $N ) or die( "error in closing $N: $!\n" ); }; |
|
0
|
|
|
|
|
0
|
|
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
} |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
else { |
235
|
|
|
|
|
|
|
|
236
|
0
|
|
|
|
|
0
|
$N = $self->N; |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
$sub = sub { |
239
|
0
|
0
|
|
0
|
|
0
|
POSIX::close( $N ) |
240
|
|
|
|
|
|
|
or die( "error in closing $N: $!\n" ); |
241
|
0
|
|
|
|
|
0
|
}; |
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
} |
244
|
|
|
|
|
|
|
|
245
|
0
|
|
|
|
|
0
|
return $sub, $N; |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
} |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
sub apply { |
250
|
|
|
|
|
|
|
|
251
|
4
|
|
|
4
|
1
|
10
|
my $self = shift; |
252
|
|
|
|
|
|
|
|
253
|
4
|
|
|
|
|
6
|
my ( $N, $M ) = do { |
254
|
|
|
|
|
|
|
|
255
|
18
|
|
|
18
|
|
31187
|
no warnings 'uninitialized'; |
|
18
|
|
|
|
|
52
|
|
|
18
|
|
|
|
|
2523
|
|
256
|
|
|
|
|
|
|
|
257
|
4
|
|
|
|
|
30
|
map { $fh_map{$_} } $self->N, $self->M; |
|
8
|
|
|
|
|
56
|
|
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
}; |
260
|
|
|
|
|
|
|
|
261
|
4
|
|
|
|
|
26
|
my $mth = '_' . $self->_type; |
262
|
4
|
|
|
|
|
22
|
return $self->$mth( $N, $M ); |
263
|
|
|
|
|
|
|
} |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
1; |
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
# |
270
|
|
|
|
|
|
|
# This file is part of IPC-PrettyPipe |
271
|
|
|
|
|
|
|
# |
272
|
|
|
|
|
|
|
# This software is Copyright (c) 2018 by Smithsonian Astrophysical Observatory. |
273
|
|
|
|
|
|
|
# |
274
|
|
|
|
|
|
|
# This is free software, licensed under: |
275
|
|
|
|
|
|
|
# |
276
|
|
|
|
|
|
|
# The GNU General Public License, Version 3, June 2007 |
277
|
|
|
|
|
|
|
# |
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
__END__ |