[p5sagit/p5-mst-13.2.git] / lib / IPC / Open2.pm

package IPC::Open2;
require 5.000;
require Exporter;
use Carp;

=head1 NAME

IPC::Open2, open2 - open a process for both reading and writing

=head1 SYNOPSIS

    use IPC::Open2;
    $pid = open2(\*RDR, \*WTR, 'some cmd and args');
      # or
    $pid = open2(\*RDR, \*WTR, 'some', 'cmd', 'and', 'args');

=head1 DESCRIPTION

The open2() function spawns the given $cmd and connects $rdr for
reading and $wtr for writing.  It's what you think should work 
when you try

    open(HANDLE, "|cmd args|");

open2() returns the process ID of the child process.  It doesn't return on
failure: it just raises an exception matching C</^open2:/>.

=head1 WARNING 

It will not create these file handles for you.  You have to do this yourself.
So don't pass it empty variables expecting them to get filled in for you.

Additionally, this is very dangerous as you may block forever.
It assumes it's going to talk to something like B<bc>, both writing to
it and reading from it.  This is presumably safe because you "know"
that commands like B<bc> will read a line at a time and output a line at
a time.  Programs like B<sort> that read their entire input stream first,
however, are quite apt to cause deadlock.  

The big problem with this approach is that if you don't have control 
over source code being run in the the child process, you can't control what it does 
with pipe buffering.  Thus you can't just open a pipe to C<cat -v> and continually
read and write a line from it.

=head1 SEE ALSO

See L<open3> for an alternative that handles STDERR as well.

=cut

@ISA = qw(Exporter);
@EXPORT = qw(open2);

# &open2: tom christiansen, <tchrist@convex.com>
#
# usage: $pid = open2('rdr', 'wtr', 'some cmd and args');
#    or  $pid = open2('rdr', 'wtr', 'some', 'cmd', 'and', 'args');
#
# spawn the given $cmd and connect $rdr for
# reading and $wtr for writing.  return pid
# of child, or 0 on failure.  
# 
# WARNING: this is dangerous, as you may block forever
# unless you are very careful.  
# 
# $wtr is left unbuffered.
# 
# abort program if
#	rdr or wtr are null
# 	pipe or fork or exec fails

$fh = 'FHOPEN000';  # package static in case called more than once

sub open2 {
    local($kidpid);
    local($dad_rdr, $dad_wtr, @cmd) = @_;

    $dad_rdr ne '' 		|| croak "open2: rdr should not be null";
    $dad_wtr ne '' 		|| croak "open2: wtr should not be null";

    # force unqualified filehandles into callers' package
    local($package) = caller;
    $dad_rdr =~ s/^([^']+$)/$package'$1/ unless ref $dad_rdr;
    $dad_wtr =~ s/^([^']+$)/$package'$1/ unless ref $dad_wtr;

    local($kid_rdr) = ++$fh;
    local($kid_wtr) = ++$fh;

    pipe($dad_rdr, $kid_wtr) 	|| croak "open2: pipe 1 failed: $!";
    pipe($kid_rdr, $dad_wtr) 	|| croak "open2: pipe 2 failed: $!";

    if (($kidpid = fork) < 0) {
	croak "open2: fork failed: $!";
    } elsif ($kidpid == 0) {
	close $dad_rdr; close $dad_wtr;
	open(STDIN,  "<&$kid_rdr");
	open(STDOUT, ">&$kid_wtr");
	warn "execing @cmd\n" if $debug;
	exec @cmd
	    or croak "open2: exec of @cmd failed";   
    } 
    close $kid_rdr; close $kid_wtr;
    select((select($dad_wtr), $| = 1)[0]); # unbuffer pipe
    $kidpid;
}
1; # so require is happy
Commit	Line	Data
a0d0e21e	1	package IPC::Open2;
	2	require 5.000;
	3	require Exporter;
	4	use Carp;
	5
f06db76b	6	=head1 NAME
	7
	8	IPC::Open2, open2 - open a process for both reading and writing
	9
	10	=head1 SYNOPSIS
	11
	12	use IPC::Open2;
cb1a09d0	13	$pid = open2(\RDR, \WTR, 'some cmd and args');
f06db76b	14	# or
cb1a09d0	15	$pid = open2(\RDR, \WTR, 'some', 'cmd', 'and', 'args');
f06db76b	16
	17	=head1 DESCRIPTION
	18
	19	The open2() function spawns the given $cmd and connects $rdr for
	20	reading and $wtr for writing. It's what you think should work
	21	when you try
	22
1fef88e7	23	open(HANDLE, "\|cmd args\|");
f06db76b	24
	25	open2() returns the process ID of the child process. It doesn't return on
	26	failure: it just raises an exception matching C</^open2:/>.
	27
	28	=head1 WARNING
	29
	30	It will not create these file handles for you. You have to do this yourself.
	31	So don't pass it empty variables expecting them to get filled in for you.
	32
	33	Additionally, this is very dangerous as you may block forever.
	34	It assumes it's going to talk to something like B<bc>, both writing to
	35	it and reading from it. This is presumably safe because you "know"
	36	that commands like B<bc> will read a line at a time and output a line at
	37	a time. Programs like B<sort> that read their entire input stream first,
	38	however, are quite apt to cause deadlock.
	39
	40	The big problem with this approach is that if you don't have control
	41	over source code being run in the the child process, you can't control what it does
cb1a09d0	42	with pipe buffering. Thus you can't just open a pipe to C<cat -v> and continually
f06db76b	43	read and write a line from it.
	44
	45	=head1 SEE ALSO
	46
	47	See L<open3> for an alternative that handles STDERR as well.
	48
	49	=cut
	50
a0d0e21e	51	@ISA = qw(Exporter);
	52	@EXPORT = qw(open2);
	53
	54	# &open2: tom christiansen, <tchrist@convex.com>
	55	#
	56	# usage: $pid = open2('rdr', 'wtr', 'some cmd and args');
	57	# or $pid = open2('rdr', 'wtr', 'some', 'cmd', 'and', 'args');
	58	#
	59	# spawn the given $cmd and connect $rdr for
	60	# reading and $wtr for writing. return pid
	61	# of child, or 0 on failure.
	62	#
	63	# WARNING: this is dangerous, as you may block forever
	64	# unless you are very careful.
	65	#
	66	# $wtr is left unbuffered.
	67	#
	68	# abort program if
	69	# rdr or wtr are null
	70	# pipe or fork or exec fails
	71
	72	$fh = 'FHOPEN000'; # package static in case called more than once
	73
	74	sub open2 {
	75	local($kidpid);
	76	local($dad_rdr, $dad_wtr, @cmd) = @_;
	77
	78	$dad_rdr ne '' \|\| croak "open2: rdr should not be null";
	79	$dad_wtr ne '' \|\| croak "open2: wtr should not be null";
	80
	81	# force unqualified filehandles into callers' package
	82	local($package) = caller;
5428dc40	83	$dad_rdr =~ s/^([^']+$)/$package'$1/ unless ref $dad_rdr;
5428dc40	84	$dad_wtr =~ s/^([^']+$)/$package'$1/ unless ref $dad_wtr;
a0d0e21e	85
	86	local($kid_rdr) = ++$fh;
	87	local($kid_wtr) = ++$fh;
	88
	89	pipe($dad_rdr, $kid_wtr) \|\| croak "open2: pipe 1 failed: $!";
	90	pipe($kid_rdr, $dad_wtr) \|\| croak "open2: pipe 2 failed: $!";
	91
	92	if (($kidpid = fork) < 0) {
	93	croak "open2: fork failed: $!";
	94	} elsif ($kidpid == 0) {
	95	close $dad_rdr; close $dad_wtr;
	96	open(STDIN, "<&$kid_rdr");
	97	open(STDOUT, ">&$kid_wtr");
	98	warn "execing @cmd\n" if $debug;
c07a80fd	99	exec @cmd
c07a80fd	100	or croak "open2: exec of @cmd failed";
a0d0e21e	101	}
	102	close $kid_rdr; close $kid_wtr;
	103	select((select($dad_wtr), $\| = 1)[0]); # unbuffer pipe
	104	$kidpid;
	105	}
	106	1; # so require is happy
	107