# Uses RunPipe_PerlMonks module to run and trap failures in piped commands.
use strict;
use warnings;
use lib "/PATH_TO_RunPipe_PerlMonks";
use RunPipe_PerlMonks;

# Here we pass a series of piped cmds to be run by IPC::Run.
# The 3rd cmd, "grep zzzzzzzz", will fail. Goal is to identify it as the cmd that made the series fail (a normal system call only gets the status of the last cmd, which in this case is a (false) success).
my @cmds = ( ['sort'], ['uniq', '-c'], [qw(grep zzzzzzzz)], ['sort', '-rnk1'] );

my $rp = new RunPipe_PerlMonks('cmds' => \@cmds);

# This will open the FH for the cmd, like "open FH_GLOB, '|-', 'sort | uniq -c ...'", but it must be done by IPC::Run::start() since we're using it to run the cmds. Must be done before passing data to the FH.
$rp->start(\*FH_GLOB);

####### Now pump some data to the FH ######
my $max = 5;
for (my $i = 0; $i < $max; $i++)
{
	print FH_GLOB int(rand($max)) . "\n";
}
close FH_GLOB;
#############################################

# Get the FH that will contain the output so we can process it in real time (rather than waiting for everything to finish first).
my $fh = $rp->fh; # or die "Error: \$rp->fh not defined.\n";

# This forks.  The parent returns to the main program (i.e. here) immediately so we can process the results while waiting for them to finish. The child calls $ipc_run_h->finish(), which waits for all cmds (i.e. children) to finish. It doesn't work because it's a child waiting for another child. Is there a better way to do this?
$rp->run();

while (my $line = <$fh>)
{
	# do something with each output line.
	print $line;
}

close $fh;

my $failed_cmd = RunPipe_PerlMonks::failed_cmd;

# Important: we want to identify the exact cmd that failed in a series of piped cmds. A normal system call only returns the status of the last cmd. This is why we're using IPC::Run.
if (defined $failed_cmd)
{
	print "Failed! cmd = '$failed_cmd'\n";
}

##</code><code>##

package RunPipe_PerlMonks;
use strict; use warnings;
use IPC::Shareable; use IPC::Run; use FileHandle;

my $failed_cmd;	my $glue = 'h_09';

my %options = (
	create    => 'yes',
	exclusive => 1,
	mode      => 0644,
	destroy   => 1,
);

# STATIC method.
sub failed_cmd
{
	IPC::Shareable->clean_up_all;

	return $failed_cmd;
}

sub new
{
	shift; my $self = { 'cmds' => undef, @_ };
	defined $self->{'cmds'} or die "ERROR: didn't get CMD in constructor.";

	IPC::Shareable->clean_up_all;

	bless $self; return $self;
}

sub fh
{
	my $self = shift;
	return $self->{'readfh'};
}

# Input is an array of array references of commands.  For example: ( ["ls", "-al"], ["grep", "-v", "something"] );
sub start
{
	my $self = shift;
	my $fh_glob_ref = shift;

	my @cmds = @{$self->{'cmds'}} or die "Error: can't start() when CMDS not defined!\n";

	my ($readfh, $writefh) = FileHandle::pipe;

	$self->{'readfh'} = $readfh;
	$self->{'writefh'} = $writefh;

	my @ipcArray = (); my $ipc_run_h;

	#pipe each command to the next
	foreach my $cmd (@cmds)
	{
		push @ipcArray, $cmd;

		if (defined $fh_glob_ref && @ipcArray == 1) # ('<pipe', $fh) only needs to be added to the first cmd.  DO NOT added it to later cmds (doing so causes only the last cmd to be run).
		{
			push @ipcArray, '<pipe', $fh_glob_ref;
		}

		push @ipcArray, "|";

	}

	pop @ipcArray; # get rid of the last "|"

	# Capture both stdout and stderr in $writefh.
	$ipc_run_h = IPC::Run::start(@ipcArray, '>', $writefh, "2>", $writefh);

	$self->{'h'} = $ipc_run_h;
}

sub run
{
	my $self = shift;
	my $ipc_run_h = $self->{'h'};
	my $readfh = $self->{'readfh'};
	my $writefh = $self->{'writefh'};

	defined $readfh or die "Error: READFH not defined\n";
	defined $writefh or die "Error: WRITEFH not defined\n";
	defined $ipc_run_h or die "Error: ipc_run_h not defined\n";

	eval { tie($failed_cmd, 'IPC::Shareable', $glue, { %options }) };
	$@ and die "ERROR: GLUE already bound.\n";

	# Run cmd as child process, so we can return FH immediately to the running program and process the output in real time.
	my $pid = fork();

	if ($pid) # parent
	{
		my $child_pid = waitpid($pid, 0);

		if ($child_pid == -1)
		{
			die "Child stopped with an error! ($!)\n";
		}
		elsif ($child_pid == 0) # child still running
		{
			die "ERROR: Child still running, but it should not have returned until done...\n";
		}

		# if it gets here, child has finished. Close parent's copy of writeFH.
		# note: DONT close the ReadFH.  It needs to remain open for the driver program; it will trigger EOF when writeFH is closed.
		close $writefh;

		return;
	}

	####### From here onward, it's the child running.

	#******* Now call $ipc_run_h->finish(), which waitspid() each child.
	#******* THIS is the failure point in the code because now we're running as the child, and we need to waitpid() for other children (each cmd in the series).
	#******* Since a child can't waitpid another child, waitpid inside $ipc_run_h->finish() always returns -1, the correct exit code is never returned, and we can't identify the exact cmd that failed.
	if (!$ipc_run_h->finish()) #failure at some point
	{
		my $ctr = 0;
		foreach my $cmd (@{$self->{'cmds'}})
		{
			#find the point where the failure occured, get the return value at that point
			if($ipc_run_h->result($ctr) != 0){
				my $returnval = $ipc_run_h->result($ctr);

				# Set the failed command.
				$failed_cmd = join(" ",@{$cmd});
				last;
			}
			$ctr++;
		}
	}

	close $readfh;
	close $writefh;

	exit;
}

1;

##</code><code>##

# This version uses subs instead of classes.
use strict;
use warnings;

my $pid1 = fork();

if ($pid1) # parent #1
{
	my $pid2 = fork();

	if ($pid2) # parent #2
	{
		# This is just to illustrate that waitpid($pid1) works in parent #2

		# Wait for child #2 to finish so we're not interfering with its waitpid() call.
		waitpid($pid2, 0);

		my $waitpid1 = waitpid($pid1, 0);
		print "waitpid1 (in parent #2) = '$waitpid1'\n";
	}
	elsif ($pid2 == 0) # child #2
	{
		print "I'm child #2\n";

		#******* waitpid($pid1) inside child #2 will return -1.
		#******* It seems to not know about $pid1.  How can I make it work?
		my $waitpid1 = waitpid($pid1, 0);
		print "waitpid1 (in child #2) = '$waitpid1'\n";
	}
}
elsif ($pid1 == 0) # child #1
{
	print "I'm child #1\n";
}

##</code><code>##

I'm child #1
I'm child #2
waitpid1 (in child #2) = '-1'
waitpid1 (in parent #2) = '25341'