view release on metacpan or  search on metacpan

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

                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++;


    ### Abandon all hope; falls back to simple system() on verbose calls.
    } elsif ($verbose) {
        system(@cmd);
        $err = $? ? $? : 0;

    ### Non-verbose system() needs to have STDOUT and STDERR muted.
    } else {
        local *SAVEOUT; local *SAVEERR;

        open(SAVEOUT, ">&STDOUT")
            or warn(loc("couldn't dup STDOUT: %1",$!)),      return;
        open(STDOUT, ">".File::Spec->devnull)
            or warn "couldn't reopen STDOUT: $!",   return;

        open(SAVEERR, ">&STDERR")
            or warn(loc("couldn't dup STDERR: %1",$!)),      return;
        open(STDERR, ">".File::Spec->devnull)
            or warn(loc("couldn't reopen STDERR: %1",$!)),   return;

        system(@cmd);

        open(STDOUT, ">&SAVEOUT")
            or warn(loc("couldn't restore STDOUT: %1",$!)), return;
        open(STDERR, ">&SAVEERR")
            or warn(loc("couldn't restore STDERR: %1",$!)), return;
    }

    ### unless $err has been set from _open3_run, set it to $? ###
    $err ||= $?;
    
    if ( scalar @buffer ) {
        my $capture = $args->{buffer};
        $$capture = join '', @buffer;
    }
    
    return wantarray
                ? $have_buffer
                    ? (!$err, $?, \@buffer, \@bufout, \@buferr)
                    : (!$err, $? )
                : !$err
}


### IPC::Run::run emulator, using IPC::Open3.
sub _open3_run {
    my ($cmdref, $_out_handler, $_err_handler, $verbose) = @_;
    my @cmd = @$cmdref;

    ### Following code are adapted from Friar 'abstracts' in the
    ### Perl Monastery (http://www.perlmonks.org/index.pl?node_id=151886).

    my ($infh, $outfh, $errfh); # open3 handles

    my $pid = eval {
        IPC::Open3::open3(
            $infh   = Symbol::gensym(),
            $outfh  = Symbol::gensym(),
            $errfh  = Symbol::gensym(),
            @cmd,
        )
    };


    return (undef, $@) if $@;

    my $sel = IO::Select->new; # create a select object
    $sel->add($outfh, $errfh); # and add the fhs

    STDOUT->autoflush(1); STDERR->autoflush(1);
    $outfh->autoflush(1) if UNIVERSAL::can($outfh, 'autoflush');
    $errfh->autoflush(1) if UNIVERSAL::can($errfh, 'autoflush');

    while (my @ready = $sel->can_read) {
        foreach my $fh (@ready) { # loop through buffered handles
            # read up to 4096 bytes from this fh.
            my $len = sysread $fh, my($buf), 4096;

            if (not defined $len){
                # There was an error reading
                warn loc("Error from child: %1",$!);
                return(undef, $!);
            }
            elsif ($len == 0){
                $sel->remove($fh); # finished reading
                next;
            }
            elsif ($fh == $outfh) {
                $_out_handler->($buf);
            } elsif ($fh == $errfh) {
                $_err_handler->($buf);
            } else {
                warn loc("%1 error", 'IO::Select');
                return(undef, $!);
            }
        }
    }

    waitpid $pid, 0; # wait for it to die
    return 1;
}

1;

__END__

=pod

=head1 NAME

IPC::Cmd - finding and running system commands made easy

=head1 SYNOPSIS

    use IPC::Cmd qw[can_run run];

    my $full_path = can_run('wget') or warn 'wget is not installed!';


    ### commands can be arrayrefs or strings ###
    my $cmd = "$full_path -b theregister.co.uk";
    my $cmd = [$full_path, '-b', 'theregister.co.uk'];

    ### in scalar context ###
    if( run(command => $cmd, verbose => 0) ) {
        print "fetched webpage succesfully\n";
    }


    ### in list context ###
    my( $succes, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
            run( command => $cmd, verbose => 0 );

    if( $success ) {
        print "this is what the command printed:\n";
        print join "", @$full_buf;
    }


    ### don't have IPC::Cmd be verbose, ie don't print to stdout or
    ### stderr when running commands -- default is '0'
    $IPC::Cmd::VERBOSE = 0;

=head1 DESCRIPTION

IPC::Cmd allows you to run commands, interactively if desisered,
platform independant but have them still work.