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