—

              
# 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.008_001;
use IO::Handle;
use strict;
use Carp;
use Symbol;
our $VERSION = "1.55";
sub new {
    my $type = shift;
    my $class = ref($type) || $type || "IO::Pipe";
    @_ == 0 || @_ == 2 or croak "usage: $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' || $^O eq 'MSWin32';
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);
          my $handle = shift;
          # Close in child:
          unless ($^O eq 'MSWin32') {
            fcntl($handle, 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;
    $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;
    $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__
HideShow 98 lines of Pod
=head1 NAME
IO::Pipe - supply object methods for pipes
=head1 SYNOPSIS
        use IO::Pipe;
        $pipe = IO::Pipe->new();
        if($pid = fork()) { # Parent
            $pipe->reader();
            while(<$pipe>) {
                ...
            }
        }
        elsif(defined $pid) { # Child
            $pipe->writer();
            print $pipe ...
        }
        or
        $pipe = IO::Pipe->new();
        $pipe->reader(qw(ls -l));
        while(<$pipe>) {
            ...
        }
=head1 DESCRIPTION
C<IO::Pipe> provides an interface to creating pipes between
processes.
=head1 CONSTRUCTOR
=over 4
=item new ( [READER, WRITER] )
Creates an C<IO::Pipe>, which is a reference to a newly created symbol
(see the L<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.
=back
=head1 METHODS
=over 4
=item reader ([ARGS])
The object is re-blessed into a sub-class of C<IO::Handle>, and becomes a
handle at the reading end of the pipe. If C<ARGS> are given then C<fork>
is called and C<ARGS> are passed to exec.
=item writer ([ARGS])
The object is re-blessed into a sub-class of C<IO::Handle>, and becomes a
handle at the writing end of the pipe. If C<ARGS> are given then C<fork>
is called and C<ARGS> are passed to exec.
=item handles ()
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::Pipe::End>, or a subclass thereof.
=back
=head1 SEE ALSO
L<IO::Handle>
=head1 AUTHOR
Graham Barr. Currently maintained by the Perl Porters.  Please report all
bugs at L<https://github.com/Perl/perl5/issues>.
=head1 COPYRIGHT
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