Path: utzoo!utgpu!news-server.csri.toronto.edu!bonnie.concordia.ca!uunet!convex!usenet
From: tchrist@convex.COM (Tom Christiansen)
Newsgroups: comp.lang.perl
Subject: Re: Double-ended pipes
Keywords: pipe
Message-ID: <1991Jun16.041017.4307@convex.com>
Date: 16 Jun 91 04:10:17 GMT
References: <1991Jun10.180301.7925@NCoast.ORG> <14054@pasteur.Berkeley.EDU>
Sender: usenet@convex.com (news access account)
Reply-To: tchrist@convex.COM (Tom Christiansen)
Organization: CONVEX Software Development, Richardson, TX
Lines: 117
Nntp-Posting-Host: concave.convex.com

From the keyboard of lars@yosemite.berkeley.edu.UUCP (Lars E. Thon):
:One feature that I have been missing from perl is having a double-ended
:pipe. This could be useful f.ex. if you want to feed a lot of commands
:to a csh and then analyze output and/or status from the commands. For a
:simple (and contrived) example, consider the following:


From the FAQ.  I guess I should s/expect/chat2/.

--tom


[Last changed: $Date: 91/06/02 14:13:23 $ by $Author: tchrist $]

20) How do I open a pipe both to and from a command?

    In general, this is a dangerous move because you can find yourself in
    deadlock situation.  It's better to put one end of the pipe to a file.
    For example:

	# first write some_cmd's input into a_file, then 
	open(CMD, "some_cmd its_args < a_file |");
	while (<CMD>) {

	# or else the other way; run the cmd
	open(CMD, "| some_cmd its_args > a_file");
	while ($condition) {
	    print CMD "some output\n";
	    # other code deleted
	} 
	close CMD || warn "cmd exited $?";

	# now read the file
	open(FILE,"a_file");
	while (<FILE>) {

    If you have ptys, you could arrange to run the command on a pty and
    avoid the deadlock problem.  See the expect.pl package released
    by Randal Schwartz <merlyn@iwarp.intel.com> for ways to do this.

    At the risk of deadlock, it is theoretically possible to use a
    fork, two pipe calls, and an exec to manually set up the two-way
    pipe.  (BSD system may use socketpair() in place of the two pipes,
    but this is not as portable.)

    Here's one example of this that assumes it's going to talk to
    something like adb, both writing to it and reading from it.  This
    is presumably safe because you "know" that commands like adb will
    read a line at a time and output a line at a time.  Programs like
    sort that read their entire input stream first, however, are quite
    apt to cause deadlock.

    Use this way:

	require 'open2.pl';
	$child = &open2(RDR,WTR,"some cmd to run and its args");

    Unqualified filehandles will be interpreted in their caller's package,
    although &open2 lives in its open package (to protect its state data).
    It returns the child process's pid if successful, and generally 
    dies if unsuccessful.  You may wish to change the dies to warnings,
    or trap the call in an eval.  You should also flush STDOUT before
    calling this.

    # &open2: tom christiansen, <tchrist@convex.com>
    #
    # usage: $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

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

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

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

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

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

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

	if (($kidpid = fork) < 0) {
	    die "open2: fork failed: $!";
	} elsif ($kidpid == 0) {
	    close $dad_rdr; close $dad_wtr;
	    open(STDIN,  ">&$kid_rdr");
	    open(STDOUT, ">&$kid_wtr");
	    print STDERR "execing $cmd\n";
	    exec $cmd;
	    die "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