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> provides an interface to createing pipes between
  42 processes.
  43
  44 =head1 CONSTRCUTOR
  45
  46 =over 4
  47
  48 =item new ( [READER, WRITER] )
  49
  50 Creates a C<IO::Pipe>, which is a reference to a
  51 newly created symbol (see the C<Symbol> package). C<IO::Pipe::new>
  52 optionally takes two arguments, which should be objects blessed into
  53 C<IO::Handle>, or a subclass thereof. These two objects will be used
  54 for the system call to C<pipe>. If no arguments are given then then
  55 method C<handles> is called on the new C<IO::Pipe> object.
  56
  57 These two handles are held in the array part of the GLOB until either
  58 C<reader> or C<writer> is called.
  59
  60 =back
  61
  62 =head1 METHODS
  63
  64 =over 4
  65
  66 =item reader ([ARGS])
  67
  68 The object is re-blessed into a sub-class of C<IO::Handle>, and becomes a
  69 handle at the reading end of the pipe. If C<ARGS> are given then C<fork>
  70 is called and C<ARGS> are passed to exec.
  71
  72 =item writer ([ARGS])
  73
  74 The object is re-blessed into a sub-class of C<IO::Handle>, and becomes a
  75 handle at the writing end of the pipe. If C<ARGS> are given then C<fork>
  76 is called and C<ARGS> are passed to exec.
  77
  78 =item handles ()
  79
  80 This method is called during construction by C<IO::Pipe::new>
  81 on the newly created C<IO::Pipe> object. It returns an array of two objects
  82 blessed into C<IO::Handle>, or a subclass thereof.
  83
  84 =back
  85
  86 =head1 SEE ALSO
  87
  88 L<IO::Handle>
  89
  90 =head1 AUTHOR
  91
  92 Graham Barr E<lt>F<bodg@tiuk.ti.com>E<gt>
  93
  94 =head1 REVISION
  95
  96 $Revision: 1.7 $
  97
  98 =head1 COPYRIGHT
  99
 100 Copyright (c) 1995 Graham Barr. All rights reserved. This program is free
 101 software; you can redistribute it and/or modify it under the same terms
 102 as Perl itself.
 103
 104 =cut
 105
 106 require 5.000;
 107 use     vars qw($VERSION);
 108 use     Carp;
 109 use     Symbol;
 110 require IO::Handle;
 111
 112 $VERSION = sprintf("%d.%02d", q$Revision: 1.7 $ =~ /(\d+)\.(\d+)/);
 113
 114 sub new {
 115     my $type = shift;
 116     my $class = ref($type) || $type || "IO::Pipe";
 117     @_ == 0 || @_ == 2 or croak "usage: new $class [READFH, WRITEFH]";
 118
 119     my $me = bless gensym(), $class;
 120
 121     my($readfh,$writefh) = @_ ? @_ : $me->handles;
 122
 123     pipe($readfh, $writefh)
 124         or return undef;
 125
 126     @{*$me} = ($readfh, $writefh);
 127
 128     $me;
 129 }
 130
 131 sub handles {
 132     @_ == 1 or croak 'usage: $pipe->handles()';
 133     (IO::Handle->new(), IO::Handle->new());
 134 }
 135
 136 sub _doit {
 137     my $me = shift;
 138     my $rw = shift;
 139
 140     my $pid = fork();
 141
 142     if($pid) { # Parent
 143         return $pid;
 144     }
 145     elsif(defined $pid) { # Child
 146         my $fh = $rw ? $me->reader() : $me->writer();
 147         my $io = $rw ? \*STDIN : \*STDOUT;
 148
 149         bless $io, "IO::Handle";
 150         $io->fdopen($fh, $rw ? "r" : "w");
 151         exec @_ or
 152             croak "IO::Pipe: Cannot exec: $!";
 153     }
 154     else {
 155         croak "IO::Pipe: Cannot fork: $!";
 156     }
 157
 158     # NOT Reached
 159 }
 160
 161 sub reader {
 162     @_ >= 1 or croak 'usage: $pipe->reader()';
 163     my $me = shift;
 164     my $fh  = ${*$me}[0];
 165     my $pid = $me->_doit(0,@_)
 166         if(@_);
 167
 168     bless $me, ref($fh);
 169     *{*$me} = *{*$fh};          # Alias self to handle
 170     bless $fh;                  # Really wan't un-bless here
 171     ${*$me}{'io_pipe_pid'} = $pid
 172         if defined $pid;
 173
 174     $me;
 175 }
 176
 177 sub writer {
 178     @_ >= 1 or croak 'usage: $pipe->writer()';
 179     my $me = shift;
 180     my $fh  = ${*$me}[1];
 181     my $pid = $me->_doit(1,@_)
 182         if(@_);
 183
 184     bless $me, ref($fh);
 185     *{*$me} = *{*$fh};          # Alias self to handle
 186     bless $fh;                  # Really wan't un-bless here
 187     ${*$me}{'io_pipe_pid'} = $pid
 188         if defined $pid;
 189
 190     $me;
 191 }
 192
 193 1;
 194