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.
21 my $class = ref($type) || $type || "IO::Pipe";
22 @_ == 0 || @_ == 2 or croak "usage: new $class [READFH, WRITEFH]";
24 my $me = bless gensym(), $class;
26 my($readfh,$writefh) = @_ ? @_ : $me->handles;
28 pipe($readfh, $writefh)
31 @{*$me} = ($readfh, $writefh);
37 @_ == 1 or croak 'usage: $pipe->handles()';
38 (IO::Pipe::End->new(), IO::Pipe::End->new());
41 my $do_spawn = $^O eq 'os2' || $^O eq 'MSWin32';
47 my $pid = $do_spawn ? 0 : fork();
52 elsif(defined $pid) { # Child or spawn
54 my $io = $rw ? \*STDIN : \*STDOUT;
55 my ($mode, $save) = $rw ? "r" : "w";
58 $save = IO::Handle->new_from_fd($io, $mode);
61 unless ($^O eq 'MSWin32') {
62 fcntl($handle, Fcntl::F_SETFD(), 1) or croak "fcntl: $!";
64 $fh = $rw ? ${*$me}[0] : ${*$me}[1];
67 $fh = $rw ? $me->reader() : $me->writer(); # close the other end
69 bless $io, "IO::Handle";
70 $io->fdopen($fh, $mode);
74 $pid = eval { system 1, @_ }; # 1 == P_NOWAIT
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;
83 croak "IO::Pipe: Cannot exec: $!";
87 croak "IO::Pipe: Cannot fork: $!";
94 @_ >= 1 or croak 'usage: $pipe->reader( [SUB_COMMAND_ARGS] )';
98 unless(ref($me) || ref($me = $me->new));
102 $pid = $me->_doit(0, $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
118 @_ >= 1 or croak 'usage: $pipe->writer( [SUB_COMMAND_ARGS] )';
122 unless(ref($me) || ref($me = $me->new));
126 $pid = $me->_doit(1, $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
141 package IO::Pipe::End;
145 @ISA = qw(IO::Handle);
149 my $r = $fh->SUPER::close(@_);
151 waitpid(${*$fh}{'io_pipe_pid'},0)
152 if(defined ${*$fh}{'io_pipe_pid'});
163 IO::Pipe - supply object methods for pipes
169 $pipe = new IO::Pipe;
171 if($pid = fork()) { # Parent
179 elsif(defined $pid) { # Child
187 $pipe = new IO::Pipe;
189 $pipe->reader(qw(ls -l));
197 C<IO::Pipe> provides an interface to creating pipes between
204 =item new ( [READER, WRITER] )
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.
213 These two handles are held in the array part of the GLOB until either
214 C<reader> or C<writer> is called.
222 =item reader ([ARGS])
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.
228 =item writer ([ARGS])
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.
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.
248 Graham Barr. Currently maintained by the Perl Porters. Please report all
249 bugs to <perl5-porters@perl.org>.
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.