view release on metacpan or  search on metacpan

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

    ### 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";
    }