<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;"># IO::Pipe.pm
#
# Copyright (c) 1996-8 Graham Barr &lt;gbarr@pobox.com&gt;. 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.40";

sub new {
    my $type = shift;
    my $class = ref($type) || $type || "IO::Pipe";
    @_ == 0 || @_ == 2 or croak "usage: $class-&gt;([READFH, WRITEFH])";

    my $me = bless gensym(), $class;

    my($readfh,$writefh) = @_ ? @_ : $me-&gt;handles;

    pipe($readfh, $writefh)
	or return undef;

    @{*$me} = ($readfh, $writefh);

    $me;
}

sub handles {
    @_ == 1 or croak 'usage: $pipe-&gt;handles()';
    (IO::Pipe::End-&gt;new(), IO::Pipe::End-&gt;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-&gt;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-&gt;reader() : $me-&gt;writer(); # close the other end
        }
        bless $io, "IO::Handle";
        $io-&gt;fdopen($fh, $mode);
	$fh-&gt;close;

        if ($do_spawn) {
          $pid = eval { system 1, @_ }; # 1 == P_NOWAIT
          my $err = $!;
    
          $io-&gt;fdopen($save, $mode);
          $save-&gt;close or croak "Cannot close $!";
          croak "IO::Pipe: Cannot spawn-NOWAIT: $err" if not $pid or $pid &lt; 0;
          return $pid;
        } else {
          exec @_ or
            croak "IO::Pipe: Cannot exec: $!";
        }
    }
    else {
        croak "IO::Pipe: Cannot fork: $!";
    }

    # NOT Reached
}

sub reader {
    @_ &gt;= 1 or croak 'usage: $pipe-&gt;reader( [SUB_COMMAND_ARGS] )';
    my $me = shift;

    return undef
	unless(ref($me) || ref($me = $me-&gt;new));

    my $fh  = ${*$me}[0];
    my $pid;
    $pid = $me-&gt;_doit(0, $fh, @_)
        if(@_);

    close ${*$me}[1];
    bless $me, ref($fh);
    *$me = *$fh;          # Alias self to handle
    $me-&gt;fdopen($fh-&gt;fileno,"r")
	unless defined($me-&gt;fileno);
    bless $fh;                  # Really wan't un-bless here
    ${*$me}{'io_pipe_pid'} = $pid
        if defined $pid;

    $me;
}

sub writer {
    @_ &gt;= 1 or croak 'usage: $pipe-&gt;writer( [SUB_COMMAND_ARGS] )';
    my $me = shift;

    return undef
	unless(ref($me) || ref($me = $me-&gt;new));

    my $fh  = ${*$me}[1];
    my $pid;
    $pid = $me-&gt;_doit(1, $fh, @_)
        if(@_);

    close ${*$me}[0];
    bless $me, ref($fh);
    *$me = *$fh;          # Alias self to handle
    $me-&gt;fdopen($fh-&gt;fileno,"w")
	unless defined($me-&gt;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-&gt;SUPER::close(@_);

    waitpid(${*$fh}{'io_pipe_pid'},0)
	if(defined ${*$fh}{'io_pipe_pid'});

    $r;
}

1;

__END__

</pre></body></html>