[Summary view] [Print] [Text view]

   1  # IO::Pipe.pm
   2  #
   3  # Copyright (c) 1996-8 Graham Barr <gbarr@pobox.com>. All rights reserved.
   4  # This program is free software; you can redistribute it and/or
   5  # modify it under the same terms as Perl itself.
   6  
   7  package IO::Pipe;
   8  
   9  use 5.006_001;
  10  
  11  use IO::Handle;
  12  use strict;
  13  our($VERSION);
  14  use Carp;
  15  use Symbol;
  16  
  17  $VERSION = "1.13";
  18  
  19  sub new {
  20      my $type = shift;
  21      my $class = ref($type) || $type || "IO::Pipe";
  22      @_ == 0 || @_ == 2 or croak "usage: new $class [READFH, WRITEFH]";
  23  
  24      my $me = bless gensym(), $class;
  25  
  26      my($readfh,$writefh) = @_ ? @_ : $me->handles;
  27  
  28      pipe($readfh, $writefh)
  29      or return undef;
  30  
  31      @{*$me} = ($readfh, $writefh);
  32  
  33      $me;
  34  }
  35  
  36  sub handles {
  37      @_ == 1 or croak 'usage: $pipe->handles()';
  38      (IO::Pipe::End->new(), IO::Pipe::End->new());
  39  }
  40  
  41  my $do_spawn = $^O eq 'os2' || $^O eq 'MSWin32';
  42  
  43  sub _doit {
  44      my $me = shift;
  45      my $rw = shift;
  46  
  47      my $pid = $do_spawn ? 0 : fork();
  48  
  49      if($pid) { # Parent
  50          return $pid;
  51      }
  52      elsif(defined $pid) { # Child or spawn
  53          my $fh;
  54          my $io = $rw ? \*STDIN : \*STDOUT;
  55          my ($mode, $save) = $rw ? "r" : "w";
  56          if ($do_spawn) {
  57            require Fcntl;
  58            $save = IO::Handle->new_from_fd($io, $mode);
  59        my $handle = shift;
  60            # Close in child:
  61        unless ($^O eq 'MSWin32') {
  62              fcntl($handle, Fcntl::F_SETFD(), 1) or croak "fcntl: $!";
  63        }
  64            $fh = $rw ? ${*$me}[0] : ${*$me}[1];
  65          } else {
  66            shift;
  67            $fh = $rw ? $me->reader() : $me->writer(); # close the other end
  68          }
  69          bless $io, "IO::Handle";
  70          $io->fdopen($fh, $mode);
  71      $fh->close;
  72  
  73          if ($do_spawn) {
  74            $pid = eval { system 1, @_ }; # 1 == P_NOWAIT
  75            my $err = $!;
  76      
  77            $io->fdopen($save, $mode);
  78            $save->close or croak "Cannot close $!";
  79            croak "IO::Pipe: Cannot spawn-NOWAIT: $err" if not $pid or $pid < 0;
  80            return $pid;
  81          } else {
  82            exec @_ or
  83              croak "IO::Pipe: Cannot exec: $!";
  84          }
  85      }
  86      else {
  87          croak "IO::Pipe: Cannot fork: $!";
  88      }
  89  
  90      # NOT Reached
  91  }
  92  
  93  sub reader {
  94      @_ >= 1 or croak 'usage: $pipe->reader( [SUB_COMMAND_ARGS] )';
  95      my $me = shift;
  96  
  97      return undef
  98      unless(ref($me) || ref($me = $me->new));
  99  
 100      my $fh  = ${*$me}[0];
 101      my $pid;
 102      $pid = $me->_doit(0, $fh, @_)
 103          if(@_);
 104  
 105      close ${*$me}[1];
 106      bless $me, ref($fh);
 107      *$me = *$fh;          # Alias self to handle
 108      $me->fdopen($fh->fileno,"r")
 109      unless defined($me->fileno);
 110      bless $fh;                  # Really wan't un-bless here
 111      ${*$me}{'io_pipe_pid'} = $pid
 112          if defined $pid;
 113  
 114      $me;
 115  }
 116  
 117  sub writer {
 118      @_ >= 1 or croak 'usage: $pipe->writer( [SUB_COMMAND_ARGS] )';
 119      my $me = shift;
 120  
 121      return undef
 122      unless(ref($me) || ref($me = $me->new));
 123  
 124      my $fh  = ${*$me}[1];
 125      my $pid;
 126      $pid = $me->_doit(1, $fh, @_)
 127          if(@_);
 128  
 129      close ${*$me}[0];
 130      bless $me, ref($fh);
 131      *$me = *$fh;          # Alias self to handle
 132      $me->fdopen($fh->fileno,"w")
 133      unless defined($me->fileno);
 134      bless $fh;                  # Really wan't un-bless here
 135      ${*$me}{'io_pipe_pid'} = $pid
 136          if defined $pid;
 137  
 138      $me;
 139  }
 140  
 141  package IO::Pipe::End;
 142  
 143  our(@ISA);
 144  
 145  @ISA = qw(IO::Handle);
 146  
 147  sub close {
 148      my $fh = shift;
 149      my $r = $fh->SUPER::close(@_);
 150  
 151      waitpid(${*$fh}{'io_pipe_pid'},0)
 152      if(defined ${*$fh}{'io_pipe_pid'});
 153  
 154      $r;
 155  }
 156  
 157  1;
 158  
 159  __END__
 160  
 161  =head1 NAME
 162  
 163  IO::Pipe - supply object methods for pipes
 164  
 165  =head1 SYNOPSIS
 166  
 167      use IO::Pipe;
 168  
 169      $pipe = new IO::Pipe;
 170  
 171      if($pid = fork()) { # Parent
 172          $pipe->reader();
 173  
 174          while(<$pipe>) {
 175          ...
 176          }
 177  
 178      }
 179      elsif(defined $pid) { # Child
 180          $pipe->writer();
 181  
 182          print $pipe ...
 183      }
 184  
 185      or
 186  
 187      $pipe = new IO::Pipe;
 188  
 189      $pipe->reader(qw(ls -l));
 190  
 191      while(<$pipe>) {
 192          ...
 193      }
 194  
 195  =head1 DESCRIPTION
 196  
 197  C<IO::Pipe> provides an interface to creating pipes between
 198  processes.
 199  
 200  =head1 CONSTRUCTOR
 201  
 202  =over 4
 203  
 204  =item new ( [READER, WRITER] )
 205  
 206  Creates an C<IO::Pipe>, which is a reference to a newly created symbol
 207  (see the C<Symbol> package). C<IO::Pipe::new> optionally takes two
 208  arguments, which should be objects blessed into C<IO::Handle>, or a
 209  subclass thereof. These two objects will be used for the system call
 210  to C<pipe>. If no arguments are given then method C<handles> is called
 211  on the new C<IO::Pipe> object.
 212  
 213  These two handles are held in the array part of the GLOB until either
 214  C<reader> or C<writer> is called.
 215  
 216  =back
 217  
 218  =head1 METHODS
 219  
 220  =over 4
 221  
 222  =item reader ([ARGS])
 223  
 224  The object is re-blessed into a sub-class of C<IO::Handle>, and becomes a
 225  handle at the reading end of the pipe. If C<ARGS> are given then C<fork>
 226  is called and C<ARGS> are passed to exec.
 227  
 228  =item writer ([ARGS])
 229  
 230  The object is re-blessed into a sub-class of C<IO::Handle>, and becomes a
 231  handle at the writing end of the pipe. If C<ARGS> are given then C<fork>
 232  is called and C<ARGS> are passed to exec.
 233  
 234  =item handles ()
 235  
 236  This method is called during construction by C<IO::Pipe::new>
 237  on the newly created C<IO::Pipe> object. It returns an array of two objects
 238  blessed into C<IO::Pipe::End>, or a subclass thereof.
 239  
 240  =back
 241  
 242  =head1 SEE ALSO
 243  
 244  L<IO::Handle>
 245  
 246  =head1 AUTHOR
 247  
 248  Graham Barr. Currently maintained by the Perl Porters.  Please report all
 249  bugs to <perl5-porters@perl.org>.
 250  
 251  =head1 COPYRIGHT
 252  
 253  Copyright (c) 1996-8 Graham Barr <gbarr@pobox.com>. All rights reserved.
 254  This program is free software; you can redistribute it and/or
 255  modify it under the same terms as Perl itself.
 256  
 257  =cut