lib/open2.pl

   1 # &open2: tom christiansen, <tchrist@convex.com>
   2 #
   3 # usage: $pid = &open2('rdr', 'wtr', 'some cmd and args');
   4 #    or  $pid = &open2('rdr', 'wtr', 'some', 'cmd', 'and', 'args');
   5 #
   6 # spawn the given $cmd and connect $rdr for
   7 # reading and $wtr for writing.  return pid
   8 # of child, or 0 on failure.
   9 #
  10 # WARNING: this is dangerous, as you may block forever
  11 # unless you are very careful.
  12 #
  13 # $wtr is left unbuffered.
  14 #
  15 # abort program if
  16 #       rdr or wtr are null
  17 #       pipe or fork or exec fails
  18
  19 package open2;
  20 $fh = 'FHOPEN000';  # package static in case called more than once
  21
  22 sub main'open2 {
  23     local($kidpid);
  24     local($dad_rdr, $dad_wtr, @cmd) = @_;
  25
  26     $dad_rdr ne ''              || die "open2: rdr should not be null";
  27     $dad_wtr ne ''              || die "open2: wtr should not be null";
  28
  29     # force unqualified filehandles into callers' package
  30     local($package) = caller;
  31     $dad_rdr =~ s/^[^']+$/$package'$&/;
  32     $dad_wtr =~ s/^[^']+$/$package'$&/;
  33
  34     local($kid_rdr) = ++$fh;
  35     local($kid_wtr) = ++$fh;
  36
  37     pipe($dad_rdr, $kid_wtr)    || die "open2: pipe 1 failed: $!";
  38     pipe($kid_rdr, $dad_wtr)    || die "open2: pipe 2 failed: $!";
  39
  40     if (($kidpid = fork) < 0) {
  41         die "open2: fork failed: $!";
  42     } elsif ($kidpid == 0) {
  43         close $dad_rdr; close $dad_wtr;
  44         open(STDIN,  "<&$kid_rdr");
  45         open(STDOUT, ">&$kid_wtr");
  46         warn "execing @cmd\n" if $debug;
  47         exec @cmd;
  48         die "open2: exec of @cmd failed";
  49     }
  50     close $kid_rdr; close $kid_wtr;
  51     select((select($dad_wtr), $| = 1)[0]); # unbuffer pipe
  52     $kidpid;
  53 }
  54 1; # so require is happy