lib/IPC/Open2.pm

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