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;
12 use vars qw[ @ISA $VERSION @EXPORT_OK $VERBOSE $DEBUG
13 $USE_IPC_RUN $USE_IPC_OPEN3 $WARN
20 $USE_IPC_RUN = IS_WIN32 && !IS_WIN98;
21 $USE_IPC_OPEN3 = not IS_VMS;
24 @EXPORT_OK = qw[can_run run];
29 use Params::Check qw[check];
30 use Module::Load::Conditional qw[can_load];
31 use Locale::Maketext::Simple Style => 'gettext';
37 IPC::Cmd - finding and running system commands made easy
41 use IPC::Cmd qw[can_run run];
43 my $full_path = can_run('wget') or warn 'wget is not installed!';
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'];
49 ### in scalar context ###
51 if( scalar run( command => $cmd,
55 print "fetched webpage successfully: $buffer\n";
59 ### in list context ###
60 my( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
61 run( command => $cmd, verbose => 0 );
64 print "this is what the command printed:\n";
65 print join "", @$full_buf;
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;
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;
79 IPC::Cmd allows you to run commands, interactively if desired,
80 platform independent but have them still work.
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.
89 =head2 $bool = IPC::Cmd->can_use_ipc_run( [VERBOSE] )
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.
100 my $verbose = shift || 0;
102 ### ipc::run doesn't run on win98
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),
111 ### otherwise, we're good to go
115 =head2 $bool = IPC::Cmd->can_use_ipc_open3( [VERBOSE] )
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.
124 sub can_use_ipc_open3 {
126 my $verbose = shift || 0;
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.
132 ### ipc::open3 works on every platform, but it can't capture buffers
134 return unless can_load(
135 modules => { map {$_ => '0.0'} qw|IPC::Open3 IO::Select Symbol| },
136 verbose => ($WARN && $verbose),
142 =head2 $bool = IPC::Cmd->can_capture_buffer
144 Utility function that tells you if C<IPC::Cmd> is capable of
145 capturing buffers in it's current configuration.
149 sub can_capture_buffer {
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;
160 =head2 $path = can_run( PROGRAM );
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
167 Unlike C<which> and C<type>, this function is platform independent and
168 will also work on, for example, Win32.
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.
178 # a lot of VMS executables have a symbol defined
180 if ( $^O eq 'VMS' ) {
182 my $syms = VMS::DCLsym->new;
183 return $command if scalar $syms->getsym( uc $command );
188 require ExtUtils::MakeMaker;
190 if( File::Spec->file_name_is_absolute($command) ) {
191 return MM->maybe_command($command);
195 (split /\Q$Config::Config{path_sep}\E/, $ENV{PATH}),
198 my $abs = File::Spec->catfile($dir, $command);
199 return $abs if $abs = MM->maybe_command($abs);
204 =head2 $ok | ($ok, $err, $full_buf, $stdout_buff, $stderr_buff) = run( command => COMMAND, [verbose => BOOL, buffer => \$SCALAR] );
206 C<run> takes 3 arguments:
212 This is the command to execute. It may be either a string or an array
214 This is a required argument.
216 See L<CAVEATS> for remarks on how commands are parsed and their
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
226 It will default to the global setting of C<$IPC::Cmd::VERBOSE>,
227 which by default is 0.
231 This will hold all the output of a command. It needs to be a reference
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.
238 Of course, this requires that the underlying call supports buffers. See
239 the note on buffers right above.
243 C<run> will return a simple C<true> or C<false> when called in scalar
245 In list context, you will be returned a list of the following items:
251 A simple boolean indicating if the command executed without errors or
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.
262 This is an arrayreference containing all the output the command
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.
270 This is an arrayreference containing all the output sent to STDOUT the
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.
278 This is an arrayreference containing all the output sent to STDERR the
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.
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.
294 ### if the user didn't provide a buffer, we'll store it here.
297 my($verbose,$cmd,$buffer);
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' }
306 unless( check( $tmpl, \%hash, $VERBOSE ) ) {
307 Carp::carp(loc("Could not validate input: %1", Params::Check->last_error));
311 print loc("Running [%1]...\n", (ref $cmd ? "@$cmd" : $cmd)) if $verbose;
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;
319 ### buffers that are to be captured
320 my( @buffer, @buff_err, @buff_out );
323 my $_out_handler = sub {
325 return unless defined $buf;
327 print STDOUT $buf if $verbose;
329 push @buff_out, $buf;
333 my $_err_handler = sub {
335 return unless defined $buf;
337 print STDERR $buf if $verbose;
339 push @buff_err, $buf;
343 ### flag to indicate we have a buffer captured
344 my $have_buffer = __PACKAGE__->can_capture_buffer ? 1 : 0;
346 ### flag indicating if the subcall went ok
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
353 __PACKAGE__->_debug( "# Using IPC::Run. Have buffer: $have_buffer" )
356 $ok = __PACKAGE__->_ipc_run( $cmd, $_out_handler, $_err_handler );
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 ) ) {
362 __PACKAGE__->_debug( "# Using IPC::Open3. Have buffer: $have_buffer" )
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
372 ### if we are allowed to run verbose, just dispatch the system command
374 __PACKAGE__->_debug( "# Using system(). Have buffer: $have_buffer" )
376 $ok = __PACKAGE__->_system_run( (ref $cmd ? "@$cmd" : $cmd), $verbose );
380 $$buffer = join '', @buffer if @buffer;
382 ### return a list of flags and buffers (if available) in list
383 ### context, or just a simple 'ok' in scalar
386 ? ($ok, $?, \@buffer, \@buff_out, \@buff_err)
396 my $_out_handler = shift;
397 my $_err_handler = shift;
398 my $verbose = shift || 0;
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
405 ### define them beforehand, so we always have defined FH's
408 my $kidout = Symbol::gensym();
409 my $kiderror = Symbol::gensym();
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]
421 __PACKAGE__->__dup_fds( @fds_to_dup );
424 my $pid = IPC::Open3::open3(
426 (IS_WIN32 ? '>&STDOUT' : $kidout),
427 (IS_WIN32 ? '>&STDERR' : $kiderror),
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),
437 (IS_WIN32 ? \*STDOUT : $kidout)
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');
444 ### add an epxlicit break statement
445 ### code courtesy of theorbtwo from #london.pm
448 OUTER: while ( my @ready = $selector->can_read ) {
450 for my $h ( @ready ) {
453 ### $len is the amount of bytes read
454 my $len = sysread( $h, $buf, 4096 ); # try to read 4096 bytes
456 ### see perldoc -f sysread: it returns undef on error,
458 if( not defined $len ) {
459 warn(loc("Error reading from process: %1", $!));
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;
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);
477 waitpid $pid, 0; # wait for it to die
479 ### restore STDIN after duping, or STDIN will be closed for
480 ### this current perl process!
481 __PACKAGE__->__reopen_fds( @fds_to_dup );
483 return if $?; # some error occurred
491 my $_out_handler = shift;
492 my $_err_handler = shift;
494 STDOUT->autoflush(1); STDERR->autoflush(1);
500 # '/Users/kane/sources/p4/other/archive-extract/t/src/x.tgz',
507 # ['/usr/bin/gzip', '-cdf',
508 # '/Users/kane/sources/p4/other/archive-extract/t/src/x.tgz']
510 # ['/usr/bin/tar', '-tf -']
514 my @command; my $special_chars;
517 for my $item (@$cmd) {
518 if( $item =~ /([<>|&])/ ) {
519 push @command, $aref, $item;
521 $special_chars .= $1;
526 push @command, $aref;
528 @command = map { if( /([<>|&])/ ) {
529 $special_chars .= $1; $_;
533 } split( /\s*([<>|&])\s*/, $cmd );
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..
547 # @command = map { ($_ eq '|' && not $i++)
552 # push @command, \*STDIN;
556 # \*STDIN is already included in the @command, see a few lines up
557 return IPC::Run::run( @command,
568 my $verbose = shift || 0;
570 my @fds_to_dup = $verbose ? () : qw[STDOUT STDERR];
571 __PACKAGE__->__dup_fds( @fds_to_dup );
573 ### system returns 'true' on failure -- the exit code of the cmd
576 __PACKAGE__->__reopen_fds( @fds_to_dup );
586 STDOUT => [qw|>&|, \*STDOUT, Symbol::gensym() ],
587 STDERR => [qw|>&|, \*STDERR, Symbol::gensym() ],
588 STDIN => [qw|<&|, \*STDIN, Symbol::gensym() ],
591 ### dups FDs and stores them in a cache
596 __PACKAGE__->_debug( "# Closing the following fds: @fds" ) if $DEBUG;
598 for my $name ( @fds ) {
599 my($redir, $fh, $glob) = @{$Map{$name}} or (
600 Carp::carp(loc("No such FD: '%1'", $name)), next );
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", $!)),
610 ### we should re-open this filehandle right now, not
612 ### Use 2-arg version of open, as 5.5.x doesn't support
614 if( $redir eq '>&' ) {
615 open( $fh, '>' . File::Spec->devnull ) or (
616 Carp::carp(loc("Could not reopen '$name': %1", $!)),
625 ### reopens FDs from the cache
630 __PACKAGE__->_debug( "# Reopening the following fds: @fds" ) if $DEBUG;
632 for my $name ( @fds ) {
633 my($redir, $fh, $glob) = @{$Map{$name}} or (
634 Carp::carp(loc("No such FD: '%1'", $name)), next );
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", $!)),
644 ### close this FD, we're not using it anymore
654 my $msg = shift or return;
655 my $level = shift || 0;
657 local $Carp::CarpLevel += $level;
671 C<run> will try to execute your command using the following logic:
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.
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>,
687 interactive commands will still execute cleanly, and also your verbosity
688 settings will be adhered to nicely;
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.
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.
705 =head1 Global Variables
707 The behaviour of IPC::Cmd can be altered by changing the following
710 =head2 $IPC::Cmd::VERBOSE
712 This controls whether IPC::Cmd will print any output from the
713 commands to the screen or not. The default is 0;
715 =head2 $IPC::Cmd::USE_IPC_RUN
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>.
720 =head2 $IPC::Cmd::USE_IPC_OPEN3
722 This variable controls whether IPC::Cmd will try to use L<IPC::Open3>
723 when available and suitable. Defaults to true.
725 =head2 $IPC::Cmd::WARN
727 This variable controls whether run time warnings should be issued, like
728 the failure to load an C<IPC::*> module you explicitly requested.
730 Defaults to true. Turn this off at your own risk.
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.
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
752 gzip -cdf foo.tar.gz | tar -xf -
754 should either be passed as
756 "gzip -cdf foo.tar.gz | tar -xf -"
760 ['gzip', '-cdf', 'foo.tar.gz', '|', 'tar', '-xf', '-']
762 But take care not to pass it as, for example
764 ['gzip -cdf foo.tar.gz', '|', 'tar -xf -']
766 Since this will lead to issues as described above.
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.
778 C<IPC::Run>, C<IPC::Open3>
780 =head1 ACKNOWLEDGEMENTS
782 Thanks to James Mastros and Martijn van der Streek for their
783 help in getting IPC::Open3 to behave nicely.
787 Please report bugs or other issues to E<lt>bug-ipc-cmd@rt.cpan.orgE<gt>.
791 This module by Jos Boumans E<lt>kane@cpan.orgE<gt>.
795 This library is free software; you may redistribute and/or modify it
796 under the same terms as Perl itself.