ext/IO/lib/IO/Pipe.pm

   1 #
   2
   3 package IO::Pipe;
   4
   5 =head1 NAME
   6
   7 IO::pipe - supply object methods for pipes
   8
   9 =head1 SYNOPSIS
  10
  11         use IO::Pipe;
  12
  13         $pipe = new IO::Pipe;
  14
  15         if($pid = fork()) { # Parent
  16             $pipe->reader();
  17
  18             while(<$pipe> {
  19                 ....
  20             }
  21
  22         }
  23         elsif(defined $pid) { # Child
  24             $pipe->writer();
  25
  26             print $pipe ....
  27         }
  28
  29         or
  30
  31         $pipe = new IO::Pipe;
  32
  33         $pipe->reader(qw(ls -l));
  34
  35         while(<$pipe>) {
  36             ....
  37         }
  38
  39 =head1 DESCRIPTION
  40
  41 C<IO::Pipe::new> creates a C<IO::Pipe>, which is a reference to a
  42 newly created symbol (see the C<Symbol> package). C<IO::Pipe::new>
  43 optionally takes two arguments, which should be objects blessed into
  44 C<IO::Handle>, or a subclass thereof. These two objects will be used
  45 for the system call to C<pipe>. If no arguments are given then then
  46 method C<handles> is called on the new C<IO::Pipe> object.
  47
  48 These two handles are held in the array part of the GLOB untill either
  49 C<reader> or C<writer> is called.
  50
  51 =over
  52
  53 =item $fh->reader([ARGS])
  54
  55 The object is re-blessed into a sub-class of C<IO::Handle>, and becomes a
  56 handle at the reading end of the pipe. If C<ARGS> are given then C<fork>
  57 is called and C<ARGS> are passed to exec.
  58
  59 =item $fh->writer([ARGS])
  60
  61 The object is re-blessed into a sub-class of C<IO::Handle>, and becomes a
  62 handle at the writing end of the pipe. If C<ARGS> are given then C<fork>
  63 is called and C<ARGS> are passed to exec.
  64
  65 =item $fh->handles
  66
  67 This method is called during construction by C<IO::Pipe::new>
  68 on the newly created C<IO::Pipe> object. It returns an array of two objects
  69 blessed into C<IO::Handle>, or a subclass thereof.
  70
  71 =back
  72
  73 =head1 SEE ALSO
  74
  75 L<IO::Handle>
  76
  77 =head1 AUTHOR
  78
  79 Graham Barr <bodg@tiuk.ti.com>
  80
  81 =head1 REVISION
  82
  83 $Revision: 1.4 $
  84
  85 =head1 COPYRIGHT
  86
  87 Copyright (c) 1995 Graham Barr. All rights reserved. This program is free
  88 software; you can redistribute it and/or modify it under the same terms
  89 as Perl itself.
  90
  91 =cut
  92
  93 require 5.000;
  94 use     vars qw($VERSION);
  95 use     Carp;
  96 use     Symbol;
  97 require IO::Handle;
  98
  99 $VERSION = sprintf("%d.%02d", q$Revision: 1.4 $ =~ /(\d+)\.(\d+)/);
 100
 101 sub new {
 102     @_ == 1 || @_ == 3 or croak 'usage: new IO::Pipe([$READFH, $WRITEFH])';
 103
 104     my $me = bless gensym(), shift;
 105
 106     my($readfh,$writefh) = @_ ? @_ : $me->handles;
 107
 108     pipe($readfh, $writefh)
 109         or return undef;
 110
 111     @{*$me} = ($readfh, $writefh);
 112
 113     $me;
 114 }
 115
 116 sub handles {
 117     @_ == 1 or croak 'usage: $pipe->handles()';
 118     (IO::Handle->new(), IO::Handle->new());
 119 }
 120
 121 sub _doit {
 122     my $me = shift;
 123     my $rw = shift;
 124
 125     my $pid = fork();
 126
 127     if($pid) { # Parent
 128         return $pid;
 129     }
 130     elsif(defined $pid) { # Child
 131         my $fh = $rw ? $me->reader() : $me->writer();
 132         my $io = $rw ? \*STDIN : \*STDOUT;
 133
 134         bless $io, "IO::Handle";
 135         $io->fdopen($fh, $rw ? "r" : "w");
 136         exec @_ or
 137             croak "IO::Pipe: Cannot exec: $!";
 138     }
 139     else {
 140         croak "IO::Pipe: Cannot fork: $!";
 141     }
 142
 143     # NOT Reached
 144 }
 145
 146 sub reader {
 147     @_ >= 1 or croak 'usage: $pipe->reader()';
 148     my $me = shift;
 149     my $fh  = ${*$me}[0];
 150     my $pid = $me->_doit(0,@_)
 151         if(@_);
 152
 153     bless $me, ref($fh);
 154     *{*$me} = *{*$fh};          # Alias self to handle
 155     ${*$me}{'io_pipe_pid'} = $pid
 156         if defined $pid;
 157
 158     $me;
 159 }
 160
 161 sub writer {
 162     @_ >= 1 or croak 'usage: $pipe->writer()';
 163     my $me = shift;
 164     my $fh  = ${*$me}[1];
 165     my $pid = $me->_doit(1,@_)
 166         if(@_);
 167
 168     bless $me, ref($fh);
 169     *{*$me} = *{*$fh};          # Alias self to handle
 170     ${*$me}{'io_pipe_pid'} = $pid
 171         if defined $pid;
 172
 173     $me;
 174 }
 175
 176 1;
 177