home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl502b.zip / lib / IPC / Open2.pm next >
Text File  |  1996-01-29  |  3KB  |  108 lines
  1. package IPC::Open2;
  2. require 5.000;
  3. require Exporter;
  4. use Carp;
  5.  
  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;
  13.     $pid = open2(\*RDR, \*WTR, 'some cmd and args');
  14.       # or
  15.     $pid = open2(\*RDR, \*WTR, 'some', 'cmd', 'and', 'args');
  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.  
  23.     open(HANDLE, "|cmd args");
  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 
  42. with pipe buffering.  Thus you can't just open a pipe to C<cat -v> and continually
  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.  
  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;
  83.     $dad_rdr =~ s/^[^']+$/$package'$&/ unless ref $dad_rdr;
  84.     $dad_wtr =~ s/^[^']+$/$package'$&/ unless ref $dad_wtr;
  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;
  99.     exec @cmd
  100.         or croak "open2: exec of @cmd failed";   
  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.  
  108.