File Coverage

lib/IPC/Open3/Simple.pm

Criterion	Covered	Total	%
statement	62	63	98.4
branch	18	20	90.0
condition	5	9	55.5
subroutine	9	9	100.0
pod	2	2	100.0
total	96	103	93.2

#################################################################
#
#   IPC::Open3::Simple - A simple alternative to IPC::Open3
#
#   $Id: Simple.pm,v 1.7 2006/07/20 13:30:02 erwan Exp $
#
#   060714 erwan Created
#
#################################################################

use strict;
use warnings;

package IPC::Open3::Simple;

use Carp qw(croak confess);
use IPC::Open3;
use IO::Select;
use IO::Handle;
use Data::Dumper;

our $VERSION = '0.04';

#-----------------------------------------------------------------
#
#   new - constructor. takes a hash where keys are in, out and err
#         and values are closures/coderefs
#

sub new {
    my($pkg,%args) = @_;
    $pkg = ref $pkg || $pkg;
    my $self = bless({},$pkg);

    foreach my $type ('in','out','err') {
	if (exists $args{$type}) {
	    croak "".__PACKAGE__."::new expects coderefs" if (ref $args{$type} ne 'CODE');
	    $self->{$type} = $args{$type};
	}
    }

    return $self;
}

#-----------------------------------------------------------------
#
#   run - execute a list of shell commands in a separate process
#         and redirect input/output to the closures provided to new()
#

sub run {
    my($self,@args) = @_;

    # note: in theory, it should work to write:
    #     my $pid = open3($child_in, $child_out, $child_err, @arguments)
    # but that does not work (bug?). $child_err is then undefined
    # (in perldoc for open2, the explanation is that stderr=stdout if $child_out == $child_err, which they do when they are both undefined)

    # TODO: support interactive ipc with child process?

    my $pid = open3(\*CHILD_IN, \*CHILD_OUT, \*CHILD_ERR, @args)
 	or confess "ERROR: failed to execute command [".join(" ",@args)."]";

    my $reader = IO::Select->new();

    my $child_in = \*CHILD_IN;
    my $child_out = \*CHILD_OUT;
    my $child_err = \*CHILD_ERR;
#    $child_in->autoflush; IPC::Open3 does it already
    $child_out->autoflush;
    $child_err->autoflush;

    # listen to stdout and stderr, or close them
    if (exists $self->{out}) {
	$reader->add($child_out);
    } else {
	$child_out->close();
    }

    if (exists $self->{err}) {
	$reader->add($child_err);
    } else {
	$child_err->close();
    }

    # forward stdin to provided function, or close it
    if (exists $self->{in}) {
	&{$self->{in}}($child_in);
    } else {
	$child_in->close();
    }

    # parse output of cvs command
    if ($reader->handles) {
	while (my @ready = $reader->can_read()) {
	    foreach my $fh (@ready) {
		my $line = <$fh>;
		if (!defined $line) {
                    # reached EOF on this filehandle
		    $reader->remove($fh);
		    $fh->close();
		} else {
		    chomp $line;
		    if ($child_out->opened && fileno($fh) == fileno(\*CHILD_OUT)) {
			&{$self->{out}}($line);
		    } elsif ($child_err->opened && fileno($fh) == fileno(\*CHILD_ERR)) {
			&{$self->{err}}($line);
		    } else {
			confess "BUG: got an unexpected filehandle:".Dumper($fh);
		    }
		}
	    }
	}
    }

    # wait for child process to die
    waitpid($pid, 0);

    return $self;
}

1;

__END__