+# IO::Pipe.pm
#
+# Copyright (c) 1996-8 Graham Barr <gbarr@pobox.com>. All rights reserved.
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
package IO::Pipe;
+use 5.006_001;
+
+use IO::Handle;
+use strict;
+our($VERSION);
+use Carp;
+use Symbol;
+
+$VERSION = "1.122";
+
+sub new {
+ my $type = shift;
+ my $class = ref($type) || $type || "IO::Pipe";
+ @_ == 0 || @_ == 2 or croak "usage: new $class [READFH, WRITEFH]";
+
+ my $me = bless gensym(), $class;
+
+ my($readfh,$writefh) = @_ ? @_ : $me->handles;
+
+ pipe($readfh, $writefh)
+ or return undef;
+
+ @{*$me} = ($readfh, $writefh);
+
+ $me;
+}
+
+sub handles {
+ @_ == 1 or croak 'usage: $pipe->handles()';
+ (IO::Pipe::End->new(), IO::Pipe::End->new());
+}
+
+my $do_spawn = $^O eq 'os2';
+
+sub _doit {
+ my $me = shift;
+ my $rw = shift;
+
+ my $pid = $do_spawn ? 0 : fork();
+
+ if($pid) { # Parent
+ return $pid;
+ }
+ elsif(defined $pid) { # Child or spawn
+ my $fh;
+ my $io = $rw ? \*STDIN : \*STDOUT;
+ my ($mode, $save) = $rw ? "r" : "w";
+ if ($do_spawn) {
+ require Fcntl;
+ $save = IO::Handle->new_from_fd($io, $mode);
+ # Close in child:
+ fcntl(shift, Fcntl::F_SETFD(), 1) or croak "fcntl: $!";
+ $fh = $rw ? ${*$me}[0] : ${*$me}[1];
+ } else {
+ shift;
+ $fh = $rw ? $me->reader() : $me->writer(); # close the other end
+ }
+ bless $io, "IO::Handle";
+ $io->fdopen($fh, $mode);
+ $fh->close;
+
+ if ($do_spawn) {
+ $pid = eval { system 1, @_ }; # 1 == P_NOWAIT
+ my $err = $!;
+
+ $io->fdopen($save, $mode);
+ $save->close or croak "Cannot close $!";
+ croak "IO::Pipe: Cannot spawn-NOWAIT: $err" if not $pid or $pid < 0;
+ return $pid;
+ } else {
+ exec @_ or
+ croak "IO::Pipe: Cannot exec: $!";
+ }
+ }
+ else {
+ croak "IO::Pipe: Cannot fork: $!";
+ }
+
+ # NOT Reached
+}
+
+sub reader {
+ @_ >= 1 or croak 'usage: $pipe->reader( [SUB_COMMAND_ARGS] )';
+ my $me = shift;
+
+ return undef
+ unless(ref($me) || ref($me = $me->new));
+
+ my $fh = ${*$me}[0];
+ my $pid = $me->_doit(0, $fh, @_)
+ if(@_);
+
+ close ${*$me}[1];
+ bless $me, ref($fh);
+ *$me = *$fh; # Alias self to handle
+ $me->fdopen($fh->fileno,"r")
+ unless defined($me->fileno);
+ bless $fh; # Really wan't un-bless here
+ ${*$me}{'io_pipe_pid'} = $pid
+ if defined $pid;
+
+ $me;
+}
+
+sub writer {
+ @_ >= 1 or croak 'usage: $pipe->writer( [SUB_COMMAND_ARGS] )';
+ my $me = shift;
+
+ return undef
+ unless(ref($me) || ref($me = $me->new));
+
+ my $fh = ${*$me}[1];
+ my $pid = $me->_doit(1, $fh, @_)
+ if(@_);
+
+ close ${*$me}[0];
+ bless $me, ref($fh);
+ *$me = *$fh; # Alias self to handle
+ $me->fdopen($fh->fileno,"w")
+ unless defined($me->fileno);
+ bless $fh; # Really wan't un-bless here
+ ${*$me}{'io_pipe_pid'} = $pid
+ if defined $pid;
+
+ $me;
+}
+
+package IO::Pipe::End;
+
+our(@ISA);
+
+@ISA = qw(IO::Handle);
+
+sub close {
+ my $fh = shift;
+ my $r = $fh->SUPER::close(@_);
+
+ waitpid(${*$fh}{'io_pipe_pid'},0)
+ if(defined ${*$fh}{'io_pipe_pid'});
+
+ $r;
+}
+
+1;
+
+__END__
+
=head1 NAME
IO::Pipe - supply object methods for pipes
if($pid = fork()) { # Parent
$pipe->reader();
- while(<$pipe> {
- ....
+ while(<$pipe>) {
+ ...
}
}
elsif(defined $pid) { # Child
$pipe->writer();
- print $pipe ....
+ print $pipe ...
}
or
$pipe->reader(qw(ls -l));
while(<$pipe>) {
- ....
+ ...
}
=head1 DESCRIPTION
-C<IO::Pipe> provides an interface to createing pipes between
+C<IO::Pipe> provides an interface to creating pipes between
processes.
-=head1 CONSTRCUTOR
+=head1 CONSTRUCTOR
=over 4
=item new ( [READER, WRITER] )
-Creates a C<IO::Pipe>, which is a reference to a
-newly created symbol (see the C<Symbol> package). C<IO::Pipe::new>
-optionally takes two arguments, which should be objects blessed into
-C<IO::Handle>, or a subclass thereof. These two objects will be used
-for the system call to C<pipe>. If no arguments are given then then
-method C<handles> is called on the new C<IO::Pipe> object.
+Creates an C<IO::Pipe>, which is a reference to a newly created symbol
+(see the C<Symbol> package). C<IO::Pipe::new> optionally takes two
+arguments, which should be objects blessed into C<IO::Handle>, or a
+subclass thereof. These two objects will be used for the system call
+to C<pipe>. If no arguments are given then method C<handles> is called
+on the new C<IO::Pipe> object.
These two handles are held in the array part of the GLOB until either
C<reader> or C<writer> is called.
This method is called during construction by C<IO::Pipe::new>
on the newly created C<IO::Pipe> object. It returns an array of two objects
-blessed into C<IO::Handle>, or a subclass thereof.
+blessed into C<IO::Pipe::End>, or a subclass thereof.
=back
=head1 AUTHOR
-Graham Barr E<lt>F<bodg@tiuk.ti.com>E<gt>
-
-=head1 REVISION
-
-$Revision: 1.7 $
+Graham Barr. Currently maintained by the Perl Porters. Please report all
+bugs to <perl5-porters@perl.org>.
=head1 COPYRIGHT
-Copyright (c) 1995 Graham Barr. All rights reserved. This program is free
-software; you can redistribute it and/or modify it under the same terms
-as Perl itself.
+Copyright (c) 1996-8 Graham Barr <gbarr@pobox.com>. All rights reserved.
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
=cut
-
-require 5.000;
-use vars qw($VERSION);
-use Carp;
-use Symbol;
-require IO::Handle;
-
-$VERSION = sprintf("%d.%02d", q$Revision: 1.7 $ =~ /(\d+)\.(\d+)/);
-
-sub new {
- my $type = shift;
- my $class = ref($type) || $type || "IO::Pipe";
- @_ == 0 || @_ == 2 or croak "usage: new $class [READFH, WRITEFH]";
-
- my $me = bless gensym(), $class;
-
- my($readfh,$writefh) = @_ ? @_ : $me->handles;
-
- pipe($readfh, $writefh)
- or return undef;
-
- @{*$me} = ($readfh, $writefh);
-
- $me;
-}
-
-sub handles {
- @_ == 1 or croak 'usage: $pipe->handles()';
- (IO::Handle->new(), IO::Handle->new());
-}
-
-sub _doit {
- my $me = shift;
- my $rw = shift;
-
- my $pid = fork();
-
- if($pid) { # Parent
- return $pid;
- }
- elsif(defined $pid) { # Child
- my $fh = $rw ? $me->reader() : $me->writer();
- my $io = $rw ? \*STDIN : \*STDOUT;
-
- bless $io, "IO::Handle";
- $io->fdopen($fh, $rw ? "r" : "w");
- exec @_ or
- croak "IO::Pipe: Cannot exec: $!";
- }
- else {
- croak "IO::Pipe: Cannot fork: $!";
- }
-
- # NOT Reached
-}
-
-sub reader {
- @_ >= 1 or croak 'usage: $pipe->reader()';
- my $me = shift;
- my $fh = ${*$me}[0];
- my $pid = $me->_doit(0,@_)
- if(@_);
-
- bless $me, ref($fh);
- *{*$me} = *{*$fh}; # Alias self to handle
- bless $fh; # Really wan't un-bless here
- ${*$me}{'io_pipe_pid'} = $pid
- if defined $pid;
-
- $me;
-}
-
-sub writer {
- @_ >= 1 or croak 'usage: $pipe->writer()';
- my $me = shift;
- my $fh = ${*$me}[1];
- my $pid = $me->_doit(1,@_)
- if(@_);
-
- bless $me, ref($fh);
- *{*$me} = *{*$fh}; # Alias self to handle
- bless $fh; # Really wan't un-bless here
- ${*$me}{'io_pipe_pid'} = $pid
- if defined $pid;
-
- $me;
-}
-
-1;
-
projects / p5sagit/p5-mst-13.2.git / blobdiff