Commit | Line | Data |
0d4ddeff |
1 | package IPC::Cmd; |
2 | |
3 | use strict; |
4 | |
5 | BEGIN { |
6 | |
7 | use constant IS_VMS => $^O eq 'VMS' ? 1 : 0; |
8 | use constant IS_WIN32 => $^O eq 'MSWin32' ? 1 : 0; |
9 | use constant IS_WIN98 => (IS_WIN32 and !Win32::IsWinNT()) ? 1 : 0; |
10 | |
11 | use Exporter (); |
12 | use vars qw[ @ISA $VERSION @EXPORT_OK $VERBOSE $DEBUG |
13 | $USE_IPC_RUN $USE_IPC_OPEN3 $WARN |
14 | ]; |
15 | |
14c46939 |
16 | $VERSION = '0.40_1'; |
0d4ddeff |
17 | $VERBOSE = 0; |
18 | $DEBUG = 0; |
19 | $WARN = 1; |
20 | $USE_IPC_RUN = IS_WIN32 && !IS_WIN98; |
21 | $USE_IPC_OPEN3 = not IS_VMS; |
22 | |
23 | @ISA = qw[Exporter]; |
24 | @EXPORT_OK = qw[can_run run]; |
25 | } |
26 | |
27 | require Carp; |
cce6d045 |
28 | use File::Spec; |
0d4ddeff |
29 | use Params::Check qw[check]; |
30 | use Module::Load::Conditional qw[can_load]; |
31 | use Locale::Maketext::Simple Style => 'gettext'; |
32 | |
33 | =pod |
34 | |
35 | =head1 NAME |
36 | |
37 | IPC::Cmd - finding and running system commands made easy |
38 | |
39 | =head1 SYNOPSIS |
40 | |
41 | use IPC::Cmd qw[can_run run]; |
42 | |
43 | my $full_path = can_run('wget') or warn 'wget is not installed!'; |
44 | |
45 | ### commands can be arrayrefs or strings ### |
46 | my $cmd = "$full_path -b theregister.co.uk"; |
47 | my $cmd = [$full_path, '-b', 'theregister.co.uk']; |
48 | |
49 | ### in scalar context ### |
50 | my $buffer; |
51 | if( scalar run( command => $cmd, |
52 | verbose => 0, |
53 | buffer => \$buffer ) |
54 | ) { |
55 | print "fetched webpage successfully: $buffer\n"; |
56 | } |
57 | |
58 | |
59 | ### in list context ### |
60 | my( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = |
61 | run( command => $cmd, verbose => 0 ); |
62 | |
63 | if( $success ) { |
64 | print "this is what the command printed:\n"; |
65 | print join "", @$full_buf; |
66 | } |
67 | |
68 | ### check for features |
69 | print "IPC::Open3 available: " . IPC::Cmd->can_use_ipc_open3; |
70 | print "IPC::Run available: " . IPC::Cmd->can_use_ipc_run; |
71 | print "Can capture buffer: " . IPC::Cmd->can_capture_buffer; |
72 | |
73 | ### don't have IPC::Cmd be verbose, ie don't print to stdout or |
74 | ### stderr when running commands -- default is '0' |
75 | $IPC::Cmd::VERBOSE = 0; |
76 | |
77 | =head1 DESCRIPTION |
78 | |
79 | IPC::Cmd allows you to run commands, interactively if desired, |
80 | platform independent but have them still work. |
81 | |
82 | The C<can_run> function can tell you if a certain binary is installed |
83 | and if so where, whereas the C<run> function can actually execute any |
84 | of the commands you give it and give you a clear return value, as well |
85 | as adhere to your verbosity settings. |
86 | |
87 | =head1 CLASS METHODS |
88 | |
89 | =head2 $bool = IPC::Cmd->can_use_ipc_run( [VERBOSE] ) |
90 | |
91 | Utility function that tells you if C<IPC::Run> is available. |
92 | If the verbose flag is passed, it will print diagnostic messages |
93 | if C<IPC::Run> can not be found or loaded. |
94 | |
95 | =cut |
96 | |
97 | |
98 | sub can_use_ipc_run { |
99 | my $self = shift; |
100 | my $verbose = shift || 0; |
101 | |
102 | ### ipc::run doesn't run on win98 |
103 | return if IS_WIN98; |
104 | |
105 | ### if we dont have ipc::run, we obviously can't use it. |
106 | return unless can_load( |
107 | modules => { 'IPC::Run' => '0.55' }, |
108 | verbose => ($WARN && $verbose), |
109 | ); |
110 | |
111 | ### otherwise, we're good to go |
112 | return 1; |
113 | } |
114 | |
115 | =head2 $bool = IPC::Cmd->can_use_ipc_open3( [VERBOSE] ) |
116 | |
117 | Utility function that tells you if C<IPC::Open3> is available. |
118 | If the verbose flag is passed, it will print diagnostic messages |
119 | if C<IPC::Open3> can not be found or loaded. |
120 | |
121 | =cut |
122 | |
123 | |
124 | sub can_use_ipc_open3 { |
125 | my $self = shift; |
126 | my $verbose = shift || 0; |
127 | |
abb5436b |
128 | ### ipc::open3 is not working on VMS becasue of a lack of fork. |
129 | ### todo, win32 also does not have fork, so need to do more research. |
130 | return 0 if IS_VMS; |
131 | |
0d4ddeff |
132 | ### ipc::open3 works on every platform, but it can't capture buffers |
133 | ### on win32 :( |
134 | return unless can_load( |
135 | modules => { map {$_ => '0.0'} qw|IPC::Open3 IO::Select Symbol| }, |
136 | verbose => ($WARN && $verbose), |
137 | ); |
138 | |
139 | return 1; |
140 | } |
141 | |
142 | =head2 $bool = IPC::Cmd->can_capture_buffer |
143 | |
144 | Utility function that tells you if C<IPC::Cmd> is capable of |
145 | capturing buffers in it's current configuration. |
146 | |
147 | =cut |
148 | |
149 | sub can_capture_buffer { |
150 | my $self = shift; |
151 | |
152 | return 1 if $USE_IPC_RUN && $self->can_use_ipc_run; |
153 | return 1 if $USE_IPC_OPEN3 && $self->can_use_ipc_open3 && !IS_WIN32; |
154 | return; |
155 | } |
156 | |
157 | |
158 | =head1 FUNCTIONS |
159 | |
160 | =head2 $path = can_run( PROGRAM ); |
161 | |
162 | C<can_run> takes but a single argument: the name of a binary you wish |
163 | to locate. C<can_run> works much like the unix binary C<which> or the bash |
164 | command C<type>, which scans through your path, looking for the requested |
165 | binary . |
166 | |
167 | Unlike C<which> and C<type>, this function is platform independent and |
168 | will also work on, for example, Win32. |
169 | |
170 | It will return the full path to the binary you asked for if it was |
171 | found, or C<undef> if it was not. |
172 | |
173 | =cut |
174 | |
175 | sub can_run { |
176 | my $command = shift; |
177 | |
178 | # a lot of VMS executables have a symbol defined |
179 | # check those first |
180 | if ( $^O eq 'VMS' ) { |
181 | require VMS::DCLsym; |
182 | my $syms = VMS::DCLsym->new; |
183 | return $command if scalar $syms->getsym( uc $command ); |
184 | } |
185 | |
186 | require Config; |
187 | require File::Spec; |
188 | require ExtUtils::MakeMaker; |
189 | |
190 | if( File::Spec->file_name_is_absolute($command) ) { |
191 | return MM->maybe_command($command); |
192 | |
193 | } else { |
cce6d045 |
194 | for my $dir ( |
195 | (split /\Q$Config::Config{path_sep}\E/, $ENV{PATH}), |
196 | File::Spec->curdir |
197 | ) { |
0d4ddeff |
198 | my $abs = File::Spec->catfile($dir, $command); |
199 | return $abs if $abs = MM->maybe_command($abs); |
200 | } |
201 | } |
202 | } |
203 | |
204 | =head2 $ok | ($ok, $err, $full_buf, $stdout_buff, $stderr_buff) = run( command => COMMAND, [verbose => BOOL, buffer => \$SCALAR] ); |
205 | |
206 | C<run> takes 3 arguments: |
207 | |
208 | =over 4 |
209 | |
210 | =item command |
211 | |
212 | This is the command to execute. It may be either a string or an array |
213 | reference. |
214 | This is a required argument. |
215 | |
216 | See L<CAVEATS> for remarks on how commands are parsed and their |
217 | limitations. |
218 | |
219 | =item verbose |
220 | |
221 | This controls whether all output of a command should also be printed |
222 | to STDOUT/STDERR or should only be trapped in buffers (NOTE: buffers |
223 | require C<IPC::Run> to be installed or your system able to work with |
224 | C<IPC::Open3>). |
225 | |
226 | It will default to the global setting of C<$IPC::Cmd::VERBOSE>, |
227 | which by default is 0. |
228 | |
229 | =item buffer |
230 | |
231 | This will hold all the output of a command. It needs to be a reference |
232 | to a scalar. |
233 | Note that this will hold both the STDOUT and STDERR messages, and you |
234 | have no way of telling which is which. |
235 | If you require this distinction, run the C<run> command in list context |
236 | and inspect the individual buffers. |
237 | |
238 | Of course, this requires that the underlying call supports buffers. See |
239 | the note on buffers right above. |
240 | |
241 | =back |
242 | |
243 | C<run> will return a simple C<true> or C<false> when called in scalar |
244 | context. |
245 | In list context, you will be returned a list of the following items: |
246 | |
247 | =over 4 |
248 | |
249 | =item success |
250 | |
251 | A simple boolean indicating if the command executed without errors or |
252 | not. |
253 | |
254 | =item errorcode |
255 | |
256 | If the first element of the return value (success) was 0, then some |
257 | error occurred. This second element is the error code the command |
258 | you requested exited with, if available. |
259 | |
260 | =item full_buffer |
261 | |
262 | This is an arrayreference containing all the output the command |
263 | generated. |
264 | Note that buffers are only available if you have C<IPC::Run> installed, |
265 | or if your system is able to work with C<IPC::Open3> -- See below). |
266 | This element will be C<undef> if this is not the case. |
267 | |
268 | =item out_buffer |
269 | |
270 | This is an arrayreference containing all the output sent to STDOUT the |
271 | command generated. |
272 | Note that buffers are only available if you have C<IPC::Run> installed, |
273 | or if your system is able to work with C<IPC::Open3> -- See below). |
274 | This element will be C<undef> if this is not the case. |
275 | |
276 | =item error_buffer |
277 | |
278 | This is an arrayreference containing all the output sent to STDERR the |
279 | command generated. |
280 | Note that buffers are only available if you have C<IPC::Run> installed, |
281 | or if your system is able to work with C<IPC::Open3> -- See below). |
282 | This element will be C<undef> if this is not the case. |
283 | |
284 | =back |
285 | |
286 | See the C<HOW IT WORKS> Section below to see how C<IPC::Cmd> decides |
287 | what modules or function calls to use when issuing a command. |
288 | |
289 | =cut |
290 | |
291 | sub run { |
292 | my %hash = @_; |
293 | |
294 | ### if the user didn't provide a buffer, we'll store it here. |
295 | my $def_buf = ''; |
296 | |
297 | my($verbose,$cmd,$buffer); |
298 | my $tmpl = { |
299 | verbose => { default => $VERBOSE, store => \$verbose }, |
300 | buffer => { default => \$def_buf, store => \$buffer }, |
301 | command => { required => 1, store => \$cmd, |
302 | allow => sub { !ref($_[0]) or ref($_[0]) eq 'ARRAY' } |
303 | }, |
304 | }; |
305 | |
306 | unless( check( $tmpl, \%hash, $VERBOSE ) ) { |
307 | Carp::carp(loc("Could not validate input: %1", Params::Check->last_error)); |
308 | return; |
309 | }; |
310 | |
311 | print loc("Running [%1]...\n", (ref $cmd ? "@$cmd" : $cmd)) if $verbose; |
312 | |
313 | ### did the user pass us a buffer to fill or not? if so, set this |
314 | ### flag so we know what is expected of us |
315 | ### XXX this is now being ignored. in the future, we could add diagnostic |
316 | ### messages based on this logic |
317 | #my $user_provided_buffer = $buffer == \$def_buf ? 0 : 1; |
318 | |
319 | ### buffers that are to be captured |
320 | my( @buffer, @buff_err, @buff_out ); |
321 | |
322 | ### capture STDOUT |
323 | my $_out_handler = sub { |
324 | my $buf = shift; |
325 | return unless defined $buf; |
326 | |
327 | print STDOUT $buf if $verbose; |
328 | push @buffer, $buf; |
329 | push @buff_out, $buf; |
330 | }; |
331 | |
332 | ### capture STDERR |
333 | my $_err_handler = sub { |
334 | my $buf = shift; |
335 | return unless defined $buf; |
336 | |
337 | print STDERR $buf if $verbose; |
338 | push @buffer, $buf; |
339 | push @buff_err, $buf; |
340 | }; |
341 | |
342 | |
343 | ### flag to indicate we have a buffer captured |
344 | my $have_buffer = __PACKAGE__->can_capture_buffer ? 1 : 0; |
345 | |
346 | ### flag indicating if the subcall went ok |
347 | my $ok; |
348 | |
349 | ### IPC::Run is first choice if $USE_IPC_RUN is set. |
350 | if( $USE_IPC_RUN and __PACKAGE__->can_use_ipc_run( 1 ) ) { |
351 | ### ipc::run handlers needs the command as a string or an array ref |
352 | |
353 | __PACKAGE__->_debug( "# Using IPC::Run. Have buffer: $have_buffer" ) |
354 | if $DEBUG; |
355 | |
356 | $ok = __PACKAGE__->_ipc_run( $cmd, $_out_handler, $_err_handler ); |
357 | |
358 | ### since IPC::Open3 works on all platforms, and just fails on |
359 | ### win32 for capturing buffers, do that ideally |
360 | } elsif ( $USE_IPC_OPEN3 and __PACKAGE__->can_use_ipc_open3( 1 ) ) { |
361 | |
362 | __PACKAGE__->_debug( "# Using IPC::Open3. Have buffer: $have_buffer" ) |
363 | if $DEBUG; |
364 | |
365 | ### in case there are pipes in there; |
366 | ### IPC::Open3 will call exec and exec will do the right thing |
367 | $ok = __PACKAGE__->_open3_run( |
368 | ( ref $cmd ? "@$cmd" : $cmd ), |
369 | $_out_handler, $_err_handler, $verbose |
370 | ); |
371 | |
372 | ### if we are allowed to run verbose, just dispatch the system command |
373 | } else { |
374 | __PACKAGE__->_debug( "# Using system(). Have buffer: $have_buffer" ) |
375 | if $DEBUG; |
376 | $ok = __PACKAGE__->_system_run( (ref $cmd ? "@$cmd" : $cmd), $verbose ); |
377 | } |
378 | |
379 | ### fill the buffer; |
380 | $$buffer = join '', @buffer if @buffer; |
381 | |
382 | ### return a list of flags and buffers (if available) in list |
383 | ### context, or just a simple 'ok' in scalar |
384 | return wantarray |
385 | ? $have_buffer |
386 | ? ($ok, $?, \@buffer, \@buff_out, \@buff_err) |
387 | : ($ok, $? ) |
388 | : $ok |
389 | |
390 | |
391 | } |
392 | |
393 | sub _open3_run { |
394 | my $self = shift; |
395 | my $cmd = shift; |
396 | my $_out_handler = shift; |
397 | my $_err_handler = shift; |
398 | my $verbose = shift || 0; |
399 | |
400 | ### Following code are adapted from Friar 'abstracts' in the |
401 | ### Perl Monastery (http://www.perlmonks.org/index.pl?node_id=151886). |
402 | ### XXX that code didn't work. |
403 | ### we now use the following code, thanks to theorbtwo |
404 | |
405 | ### define them beforehand, so we always have defined FH's |
406 | ### to read from. |
407 | use Symbol; |
408 | my $kidout = Symbol::gensym(); |
409 | my $kiderror = Symbol::gensym(); |
410 | |
411 | ### Dup the filehandle so we can pass 'our' STDIN to the |
412 | ### child process. This stops us from having to pump input |
413 | ### from ourselves to the childprocess. However, we will need |
414 | ### to revive the FH afterwards, as IPC::Open3 closes it. |
415 | ### We'll do the same for STDOUT and STDERR. It works without |
416 | ### duping them on non-unix derivatives, but not on win32. |
417 | my @fds_to_dup = ( IS_WIN32 && !$verbose |
418 | ? qw[STDIN STDOUT STDERR] |
419 | : qw[STDIN] |
420 | ); |
421 | __PACKAGE__->__dup_fds( @fds_to_dup ); |
422 | |
423 | |
424 | my $pid = IPC::Open3::open3( |
425 | '<&STDIN', |
426 | (IS_WIN32 ? '>&STDOUT' : $kidout), |
427 | (IS_WIN32 ? '>&STDERR' : $kiderror), |
428 | $cmd |
429 | ); |
430 | |
431 | ### use OUR stdin, not $kidin. Somehow, |
432 | ### we never get the input.. so jump through |
433 | ### some hoops to do it :( |
434 | my $selector = IO::Select->new( |
435 | (IS_WIN32 ? \*STDERR : $kiderror), |
436 | \*STDIN, |
437 | (IS_WIN32 ? \*STDOUT : $kidout) |
438 | ); |
439 | |
440 | STDOUT->autoflush(1); STDERR->autoflush(1); STDIN->autoflush(1); |
441 | $kidout->autoflush(1) if UNIVERSAL::can($kidout, 'autoflush'); |
442 | $kiderror->autoflush(1) if UNIVERSAL::can($kiderror, 'autoflush'); |
443 | |
444 | ### add an epxlicit break statement |
445 | ### code courtesy of theorbtwo from #london.pm |
cce6d045 |
446 | my $stdout_done = 0; |
447 | my $stderr_done = 0; |
0d4ddeff |
448 | OUTER: while ( my @ready = $selector->can_read ) { |
449 | |
450 | for my $h ( @ready ) { |
451 | my $buf; |
452 | |
453 | ### $len is the amount of bytes read |
454 | my $len = sysread( $h, $buf, 4096 ); # try to read 4096 bytes |
455 | |
456 | ### see perldoc -f sysread: it returns undef on error, |
457 | ### so bail out. |
458 | if( not defined $len ) { |
459 | warn(loc("Error reading from process: %1", $!)); |
460 | last OUTER; |
461 | } |
462 | |
463 | ### check for $len. it may be 0, at which point we're |
464 | ### done reading, so don't try to process it. |
465 | ### if we would print anyway, we'd provide bogus information |
466 | $_out_handler->( "$buf" ) if $len && $h == $kidout; |
467 | $_err_handler->( "$buf" ) if $len && $h == $kiderror; |
cce6d045 |
468 | |
469 | ### Wait till child process is done printing to both |
470 | ### stdout and stderr. |
471 | $stdout_done = 1 if $h == $kidout and $len == 0; |
472 | $stderr_done = 1 if $h == $kiderror and $len == 0; |
473 | last OUTER if ($stdout_done && $stderr_done); |
0d4ddeff |
474 | } |
475 | } |
476 | |
477 | waitpid $pid, 0; # wait for it to die |
478 | |
479 | ### restore STDIN after duping, or STDIN will be closed for |
480 | ### this current perl process! |
481 | __PACKAGE__->__reopen_fds( @fds_to_dup ); |
482 | |
483 | return if $?; # some error occurred |
484 | return 1; |
485 | } |
486 | |
487 | |
488 | sub _ipc_run { |
489 | my $self = shift; |
490 | my $cmd = shift; |
491 | my $_out_handler = shift; |
492 | my $_err_handler = shift; |
493 | |
494 | STDOUT->autoflush(1); STDERR->autoflush(1); |
495 | |
496 | ### a command like: |
497 | # [ |
498 | # '/usr/bin/gzip', |
499 | # '-cdf', |
500 | # '/Users/kane/sources/p4/other/archive-extract/t/src/x.tgz', |
501 | # '|', |
502 | # '/usr/bin/tar', |
503 | # '-tf -' |
504 | # ] |
505 | ### needs to become: |
506 | # [ |
507 | # ['/usr/bin/gzip', '-cdf', |
508 | # '/Users/kane/sources/p4/other/archive-extract/t/src/x.tgz'] |
509 | # '|', |
510 | # ['/usr/bin/tar', '-tf -'] |
511 | # ] |
512 | |
513 | |
514 | my @command; my $special_chars; |
515 | if( ref $cmd ) { |
516 | my $aref = []; |
517 | for my $item (@$cmd) { |
518 | if( $item =~ /([<>|&])/ ) { |
519 | push @command, $aref, $item; |
520 | $aref = []; |
521 | $special_chars .= $1; |
522 | } else { |
523 | push @$aref, $item; |
524 | } |
525 | } |
526 | push @command, $aref; |
527 | } else { |
528 | @command = map { if( /([<>|&])/ ) { |
529 | $special_chars .= $1; $_; |
530 | } else { |
531 | [ split / +/ ] |
532 | } |
533 | } split( /\s*([<>|&])\s*/, $cmd ); |
534 | } |
535 | |
536 | ### if there's a pipe in the command, *STDIN needs to |
537 | ### be inserted *BEFORE* the pipe, to work on win32 |
538 | ### this also works on *nix, so we should do it when possible |
539 | ### this should *also* work on multiple pipes in the command |
540 | ### if there's no pipe in the command, append STDIN to the back |
541 | ### of the command instead. |
542 | ### XXX seems IPC::Run works it out for itself if you just |
543 | ### dont pass STDIN at all. |
544 | # if( $special_chars and $special_chars =~ /\|/ ) { |
545 | # ### only add STDIN the first time.. |
546 | # my $i; |
547 | # @command = map { ($_ eq '|' && not $i++) |
548 | # ? ( \*STDIN, $_ ) |
549 | # : $_ |
550 | # } @command; |
551 | # } else { |
552 | # push @command, \*STDIN; |
553 | # } |
554 | |
555 | |
556 | # \*STDIN is already included in the @command, see a few lines up |
557 | return IPC::Run::run( @command, |
558 | fileno(STDOUT).'>', |
559 | $_out_handler, |
560 | fileno(STDERR).'>', |
561 | $_err_handler |
562 | ); |
563 | } |
564 | |
565 | sub _system_run { |
566 | my $self = shift; |
567 | my $cmd = shift; |
568 | my $verbose = shift || 0; |
569 | |
570 | my @fds_to_dup = $verbose ? () : qw[STDOUT STDERR]; |
571 | __PACKAGE__->__dup_fds( @fds_to_dup ); |
572 | |
573 | ### system returns 'true' on failure -- the exit code of the cmd |
574 | system( $cmd ); |
575 | |
576 | __PACKAGE__->__reopen_fds( @fds_to_dup ); |
577 | |
578 | return if $?; |
579 | return 1; |
580 | } |
581 | |
582 | { use File::Spec; |
583 | use Symbol; |
584 | |
585 | my %Map = ( |
586 | STDOUT => [qw|>&|, \*STDOUT, Symbol::gensym() ], |
587 | STDERR => [qw|>&|, \*STDERR, Symbol::gensym() ], |
588 | STDIN => [qw|<&|, \*STDIN, Symbol::gensym() ], |
589 | ); |
590 | |
591 | ### dups FDs and stores them in a cache |
592 | sub __dup_fds { |
593 | my $self = shift; |
594 | my @fds = @_; |
595 | |
596 | __PACKAGE__->_debug( "# Closing the following fds: @fds" ) if $DEBUG; |
597 | |
598 | for my $name ( @fds ) { |
599 | my($redir, $fh, $glob) = @{$Map{$name}} or ( |
600 | Carp::carp(loc("No such FD: '%1'", $name)), next ); |
601 | |
602 | ### MUST use the 2-arg version of open for dup'ing for |
603 | ### 5.6.x compatibilty. 5.8.x can use 3-arg open |
604 | ### see perldoc5.6.2 -f open for details |
605 | open $glob, $redir . fileno($fh) or ( |
606 | Carp::carp(loc("Could not dup '$name': %1", $!)), |
607 | return |
608 | ); |
609 | |
610 | ### we should re-open this filehandle right now, not |
611 | ### just dup it |
7edb818e |
612 | ### Use 2-arg version of open, as 5.5.x doesn't support |
613 | ### 3-arg version =/ |
0d4ddeff |
614 | if( $redir eq '>&' ) { |
7edb818e |
615 | open( $fh, '>' . File::Spec->devnull ) or ( |
0d4ddeff |
616 | Carp::carp(loc("Could not reopen '$name': %1", $!)), |
617 | return |
618 | ); |
619 | } |
620 | } |
621 | |
622 | return 1; |
623 | } |
624 | |
625 | ### reopens FDs from the cache |
626 | sub __reopen_fds { |
627 | my $self = shift; |
628 | my @fds = @_; |
629 | |
630 | __PACKAGE__->_debug( "# Reopening the following fds: @fds" ) if $DEBUG; |
631 | |
632 | for my $name ( @fds ) { |
633 | my($redir, $fh, $glob) = @{$Map{$name}} or ( |
634 | Carp::carp(loc("No such FD: '%1'", $name)), next ); |
635 | |
636 | ### MUST use the 2-arg version of open for dup'ing for |
637 | ### 5.6.x compatibilty. 5.8.x can use 3-arg open |
638 | ### see perldoc5.6.2 -f open for details |
639 | open( $fh, $redir . fileno($glob) ) or ( |
640 | Carp::carp(loc("Could not restore '$name': %1", $!)), |
641 | return |
642 | ); |
643 | |
644 | ### close this FD, we're not using it anymore |
645 | close $glob; |
646 | } |
647 | return 1; |
648 | |
649 | } |
650 | } |
651 | |
652 | sub _debug { |
653 | my $self = shift; |
654 | my $msg = shift or return; |
655 | my $level = shift || 0; |
656 | |
657 | local $Carp::CarpLevel += $level; |
658 | Carp::carp($msg); |
659 | |
660 | return 1; |
661 | } |
662 | |
663 | |
664 | 1; |
665 | |
666 | |
667 | __END__ |
668 | |
669 | =head1 HOW IT WORKS |
670 | |
671 | C<run> will try to execute your command using the following logic: |
672 | |
673 | =over 4 |
674 | |
675 | =item * |
676 | |
677 | If you have C<IPC::Run> installed, and the variable C<$IPC::Cmd::USE_IPC_RUN> |
678 | is set to true (See the C<GLOBAL VARIABLES> Section) use that to execute |
679 | the command. You will have the full output available in buffers, interactive commands are sure to work and you are guaranteed to have your verbosity |
680 | settings honored cleanly. |
681 | |
682 | =item * |
683 | |
684 | Otherwise, if the variable C<$IPC::Cmd::USE_IPC_OPEN3> is set to true |
685 | (See the C<GLOBAL VARIABLES> Section), try to execute the command using |
686 | C<IPC::Open3>. Buffers will be available on all platforms except C<Win32>, |
cce6d045 |
687 | interactive commands will still execute cleanly, and also your verbosity |
0d4ddeff |
688 | settings will be adhered to nicely; |
689 | |
690 | =item * |
691 | |
692 | Otherwise, if you have the verbose argument set to true, we fall back |
693 | to a simple system() call. We cannot capture any buffers, but |
694 | interactive commands will still work. |
695 | |
696 | =item * |
697 | |
698 | Otherwise we will try and temporarily redirect STDERR and STDOUT, do a |
699 | system() call with your command and then re-open STDERR and STDOUT. |
700 | This is the method of last resort and will still allow you to execute |
701 | your commands cleanly. However, no buffers will be available. |
702 | |
703 | =back |
704 | |
705 | =head1 Global Variables |
706 | |
707 | The behaviour of IPC::Cmd can be altered by changing the following |
708 | global variables: |
709 | |
710 | =head2 $IPC::Cmd::VERBOSE |
711 | |
712 | This controls whether IPC::Cmd will print any output from the |
713 | commands to the screen or not. The default is 0; |
714 | |
715 | =head2 $IPC::Cmd::USE_IPC_RUN |
716 | |
717 | This variable controls whether IPC::Cmd will try to use L<IPC::Run> |
718 | when available and suitable. Defaults to true if you are on C<Win32>. |
719 | |
720 | =head2 $IPC::Cmd::USE_IPC_OPEN3 |
721 | |
722 | This variable controls whether IPC::Cmd will try to use L<IPC::Open3> |
723 | when available and suitable. Defaults to true. |
724 | |
725 | =head2 $IPC::Cmd::WARN |
726 | |
727 | This variable controls whether run time warnings should be issued, like |
728 | the failure to load an C<IPC::*> module you explicitly requested. |
729 | |
730 | Defaults to true. Turn this off at your own risk. |
731 | |
732 | =head1 Caveats |
733 | |
734 | =over 4 |
735 | |
736 | =item Whitespace |
737 | |
738 | When you provide a string as this argument, the string will be |
739 | split on whitespace to determine the individual elements of your |
740 | command. Although this will usually just Do What You Mean, it may |
741 | break if you have files or commands with whitespace in them. |
742 | |
743 | If you do not wish this to happen, you should provide an array |
744 | reference, where all parts of your command are already separated out. |
745 | Note however, if there's extra or spurious whitespace in these parts, |
746 | the parser or underlying code may not interpret it correctly, and |
747 | cause an error. |
748 | |
749 | Example: |
750 | The following code |
751 | |
752 | gzip -cdf foo.tar.gz | tar -xf - |
753 | |
754 | should either be passed as |
755 | |
756 | "gzip -cdf foo.tar.gz | tar -xf -" |
757 | |
758 | or as |
759 | |
760 | ['gzip', '-cdf', 'foo.tar.gz', '|', 'tar', '-xf', '-'] |
761 | |
762 | But take care not to pass it as, for example |
763 | |
764 | ['gzip -cdf foo.tar.gz', '|', 'tar -xf -'] |
765 | |
766 | Since this will lead to issues as described above. |
767 | |
768 | =item IO Redirect |
769 | |
770 | Currently it is too complicated to parse your command for IO |
771 | Redirections. For capturing STDOUT or STDERR there is a work around |
772 | however, since you can just inspect your buffers for the contents. |
773 | |
774 | =back |
775 | |
776 | =head1 See Also |
777 | |
778 | C<IPC::Run>, C<IPC::Open3> |
779 | |
0d4ddeff |
780 | =head1 ACKNOWLEDGEMENTS |
781 | |
782 | Thanks to James Mastros and Martijn van der Streek for their |
783 | help in getting IPC::Open3 to behave nicely. |
784 | |
cce6d045 |
785 | =head1 BUG REPORTS |
786 | |
787 | Please report bugs or other issues to E<lt>bug-ipc-cmd@rt.cpan.orgE<gt>. |
788 | |
789 | =head1 AUTHOR |
790 | |
791 | This module by Jos Boumans E<lt>kane@cpan.orgE<gt>. |
792 | |
0d4ddeff |
793 | =head1 COPYRIGHT |
794 | |
cce6d045 |
795 | This library is free software; you may redistribute and/or modify it |
796 | under the same terms as Perl itself. |
0d4ddeff |
797 | |
cce6d045 |
798 | =cut |