view release on metacpan or  search on metacpan

inc/IPC/Cmd.pm  view on Meta::CPAN

use strict;

BEGIN {
    use Exporter    ();
    use vars        qw[ @ISA $VERSION @EXPORT_OK $VERBOSE
                        $USE_IPC_RUN $USE_IPC_OPEN3
                    ];

    $VERSION        = 0.04;
    $VERBOSE        = 0;
    $USE_IPC_RUN    = 1;
    $USE_IPC_OPEN3  = 1;

    @ISA            = qw[Exporter];
    @EXPORT_OK      = qw[can_run run];
}

### check if we can run some command ###
sub can_run {
    my $command = shift;

    if( File::Spec->file_name_is_absolute($command) ) {
        return MM->maybe_command($command);
    
    } else {    
        for my $dir (split /$Config{path_sep}/, $ENV{PATH}) {
            my $abs = File::Spec->catfile($dir, $command);
            return $abs if $abs = MM->maybe_command($abs);
        }
    }
}


### Execute a command: $cmd may be a scalar or an arrayref of cmd and args
### $bufout is an scalar ref to store outputs, $verbose can override conf
sub run {
    my %hash = @_;

    my $x = '';
    my $tmpl = {
        verbose => { default    => $VERBOSE },
        command => { required   => 1,
                     allow      => sub {!(ref $_[1]) or ref $_[1] eq 'ARRAY' }
                   },
        buffer  => { default => \$x },             
    };

    my $args = check( $tmpl, \%hash, $VERBOSE )
                or ( warn(loc(q[Could not validate input!])), return );


    


    ### Kludge! This enables autoflushing for each perl process we launched.
    local $ENV{PERL5OPT} .= ' -MIPC::Cmd::System=autoflush=1';

    my $verbose     = $args->{verbose};
    my $is_win98    = ($^O eq 'MSWin32' and !Win32::IsWinNT());

    my $err;                # error flag
    my $have_buffer;        # to indicate we executed via IPC::Run or IPC::Open3
                            # only then it makes sence to return the buffers

    my (@buffer,@buferr,@bufout);

    ### STDOUT message handler
    my $_out_handler = sub {
        my $buf = shift;
        return unless defined $buf;

        print STDOUT $buf if $verbose;
        push @buffer, $buf;
        push @bufout, $buf;
    };

    ### STDERR message handler
    my $_err_handler = sub {
        my $buf = shift;
        return unless defined $buf;

        print STDERR $buf if $verbose;
        push @buffer, $buf;
        push @buferr, $buf;
    };

    my $cmd = $args->{command};
    my @cmd = ref ($cmd) ? grep(length, @{$cmd}) : $cmd;

    print loc(qq|Running [%1]...\n|,"@cmd") if $verbose;

    ### First, we prefer Barrie Slaymaker's wonderful IPC::Run module.
    if (!$is_win98 and $USE_IPC_RUN and 
        can_load(
            modules => { 'IPC::Run' => '0.55' },
            verbose => $verbose && ($^O eq 'MSWin32') ) 
    ) {
        STDOUT->autoflush(1); STDERR->autoflush(1);

        $have_buffer++;

        @cmd = ref($cmd) ? ( [ @cmd ] )
                         : map { /[<>|&]/
                                    ? $_
                                    : [ split / +/ ]
                               } split( /\s*([<>|&])\s*/, $cmd );
        
        IPC::Run::run(@cmd, \*STDIN, $_out_handler, $_err_handler) or $err++;
        
    ### Next, IPC::Open3 is know to fail on Win32, but works on Un*x.
    } elsif (   $^O !~ /^(?:MSWin32|cygwin)$/
                and $USE_IPC_OPEN3
                and can_load(
                    modules => { map{$_ => '0.0'} qw|IPC::Open3 IO::Select Symbol| },
                    verbose => $verbose
    ) ) {
        my $rv;
        ($rv,$err) = _open3_run(\@cmd, $_out_handler, $_err_handler);
        $have_buffer++;