view release on metacpan or  search on metacpan

lib/IPC/PerlSSH/Library/Run.pm  view on Meta::CPAN

#  You may distribute under the terms of either the GNU General Public License
#  or the Artistic License (the same terms as Perl itself)
#
#  (C) Paul Evans, 2009 -- leonerd@leonerd.org.uk

package IPC::PerlSSH::Library::Run;

use strict;
use warnings;

use IPC::PerlSSH::Library;

our $VERSION = '0.17';

=head1 NAME

C<IPC::PerlSSH::Library::Run> - a library of command running functions for
C<IPC::PerlSSH>

=head1 SYNOPSIS

 use IPC::PerlSSH;

 my $ips = IPC::PerlSSH->new( Host => "over.there" );

 $ips->use_library( "Run", qw( system system_out system_in ) );

 my ( $result, $out ) = $ips->call( "system_out", qw( ip addr ls ) );
 $out == 0 or die "ip failed\n";

 for (split m/\n/, $out ) {
    # some processing here...
 }

 my $result = $ips->call( "system", qw( ip addr add 1.2.3.4/28 dev eth0 ) );

 # To execute a shell command, send a single string
 my $result = $ips->call( "system_in", "1", 
    "echo >/proc/sys/net/ipv4/ip_forward"
 );

=head1 DESCRIPTION

This module provides a library of functions for executing processes on the
remote system. As well as a basic C<system()>-like wrapper, there are also
functions for passing data in to the executed process's STDIN stream, reading
from its STDOUT stream, or both simultaneously.

Each of these functions will only return once the remote process has exited.
If interaction with the process is required while it is running, a remote pipe
open may be performed instead using functions in L<IPC::PerlSSH::Library::IO>.

=cut

# Have to protect the STDIN/STDOUT streams
# Don't capture the STDERR stream unless caller asked for it

init q[
sub system_inouterr {
   my ( $capture_stderr, $stdin, $path, @args ) = @_;

   pipe( my $rd0, my $wr0 ) or die "Cannot pipe() - $!";
   pipe( my $rd1, my $wr1 ) or die "Cannot pipe() - $!";
   pipe( my $rd2, my $wr2 ) or die "Cannot pipe() - $!" if $capture_stderr;

   defined( my $kid = fork ) or die "Cannot fork - ()\n";
   if( $kid == 0 ) {
      open STDIN,  "<&=", $rd0; close $rd0; close $wr0;
      open STDOUT, ">&=", $wr1; close $rd1; close $wr1;
      if( $capture_stderr ) {
         open STDERR, ">&=", $wr2; close $rd2; close $wr2;
      }
      exec $path, @args;
      exit -1;
   }

   close $rd0;
   close $wr1;
   close $wr2 if $capture_stderr;

   my $stdout = "";
   my $stderr = "";
   my $fn0 = fileno $wr0;
   my $fn1 = fileno $rd1;
   my $fn2 = fileno $rd2 if $capture_stderr;

   local $SIG{PIPE} = "IGNORE";

   while(1) {
      undef $wr0 unless length $stdin;
      last unless $wr0 or $rd1 or $rd2;