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 <bodg@tiuk.ti.com>
  93
  94 =head1 COPYRIGHT
  95
  96 Copyright (c) 1995 Graham Barr. All rights reserved. This program is free
  97 software; you can redistribute it and/or modify it under the same terms
  98 as Perl itself.
  99
 100 =cut
 101
 102 require 5.000;
 103 use     strict;
 104 use     vars qw($VERSION);
 105 use     Carp;
 106 use     Symbol;
 107 require IO::Handle;
 108
 109 $VERSION = "1.08";
 110
 111 sub new {
 112     my $type = shift;
 113     my $class = ref($type) || $type || "IO::Pipe";
 114     @_ == 0 || @_ == 2 or croak "usage: new $class [READFH, WRITEFH]";
 115
 116     my $me = bless gensym(), $class;
 117
 118     my($readfh,$writefh) = @_ ? @_ : $me->handles;
 119
 120     pipe($readfh, $writefh)
 121         or return undef;
 122
 123     @{*$me} = ($readfh, $writefh);
 124
 125     $me;
 126 }
 127
 128 sub handles {
 129     @_ == 1 or croak 'usage: $pipe->handles()';
 130     (IO::Handle->new(), IO::Handle->new());
 131 }
 132
 133 sub _doit {
 134     my $me = shift;
 135     my $rw = shift;
 136
 137     my $pid = fork();
 138
 139     if($pid) { # Parent
 140         return $pid;
 141     }
 142     elsif(defined $pid) { # Child
 143         my $fh = $rw ? $me->reader() : $me->writer();
 144         my $io = $rw ? \*STDIN : \*STDOUT;
 145
 146         bless $io, "IO::Handle";
 147         $io->fdopen($fh, $rw ? "r" : "w");
 148         exec @_ or
 149             croak "IO::Pipe: Cannot exec: $!";
 150     }
 151     else {
 152         croak "IO::Pipe: Cannot fork: $!";
 153     }
 154
 155     # NOT Reached
 156 }
 157
 158 sub reader {
 159     @_ >= 1 or croak 'usage: $pipe->reader()';
 160     my $me = shift;
 161     my $fh  = ${*$me}[0];
 162     my $pid = $me->_doit(0,@_)
 163         if(@_);
 164
 165     close(${*$me}[1]);
 166     bless $me, ref($fh);
 167     *{*$me} = *{*$fh};                  # Alias self to handle
 168     bless $fh, 'IO::Pipe::DeadEnd';     # Really wan't un-bless here
 169     ${*$me}{'io_pipe_pid'} = $pid
 170         if defined $pid;
 171
 172     $me;
 173 }
 174
 175 sub writer {
 176     @_ >= 1 or croak 'usage: $pipe->writer()';
 177     my $me = shift;
 178     my $fh  = ${*$me}[1];
 179     my $pid = $me->_doit(1,@_)
 180         if(@_);
 181
 182     close(${*$me}[0]);
 183     bless $me, ref($fh);
 184     *{*$me} = *{*$fh};                  # Alias self to handle
 185     bless $fh, 'IO::Pipe::DeadEnd';     # Really wan't un-bless here
 186     ${*$me}{'io_pipe_pid'} = $pid
 187         if defined $pid;
 188
 189     $me;
 190 }
 191
 192 1;
 193