home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 11 Util / 11-Util.zip / unixtool.zip / TOOLS / lib / perl / open2.nt < prev    next >
Text File  |  2000-04-21  |  1KB  |  48 lines
  1. # &open2: tom christiansen, <tchrist@convex.com>
  2. # modified for NT: clark williams <jcwillia@ingr.com>
  3. #
  4. # usage: $pid = &open2('rdr', 'wtr', 'some cmd and args');
  5. #    or  $pid = &open2('rdr', 'wtr', 'some', 'cmd', 'and', 'args');
  6. #
  7. # spawn the given $cmd and connect $rdr for
  8. # reading and $wtr for writing.  return pid
  9. # of child, or 0 on failure.  
  10. # 
  11. # WARNING: this is dangerous, as you may block forever
  12. # unless you are very careful.  
  13. # 
  14. # $wtr is left unbuffered.
  15. # 
  16. # abort program if
  17. #    rdr or wtr are null
  18. #     pipe or fork or exec fails
  19.  
  20. package open2;
  21. $fh = 'FHOPEN000';  # package static in case called more than once
  22.  
  23. sub main'open2 {
  24.     local($kidpid);
  25.     local($dad_rdr, $dad_wtr, @cmd) = @_;
  26.  
  27.     $dad_rdr ne ''         || die "open2: rdr should not be null";
  28.     $dad_wtr ne ''         || die "open2: wtr should not be null";
  29.  
  30.     # force unqualified filehandles into callers' package
  31.     local($package) = caller;
  32.     $dad_rdr =~ s/^[^']+$/$package'$&/;
  33.     $dad_wtr =~ s/^[^']+$/$package'$&/;
  34.  
  35.     local($kid_rdr) = ++$fh;
  36.     local($kid_wtr) = ++$fh;
  37.  
  38.     pipe($dad_rdr, $kid_wtr)     || die "open2: pipe 1 failed: $!";
  39.     pipe($kid_rdr, $dad_wtr)     || die "open2: pipe 2 failed: $!";
  40.             
  41.     &main'Spawn (join(" ", @cmd), $kidpid, $kid_rdr, $kid_wtr, STDERR) 
  42.             || die "&Spawn failed: $!\n";
  43.     close $kid_rdr; close $kid_wtr;
  44.     select((select($dad_wtr), $| = 1)[0]); # unbuffer pipe
  45.     $kidpid;
  46. }
  47. 1; # so require is happy
  48.