<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.52";

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__

=head1 NAME

IO::Pipe - supply object methods for pipes

=head1 SYNOPSIS

	use IO::Pipe;

	$pipe = IO::Pipe-&gt;new();

	if($pid = fork()) { # Parent
	    $pipe-&gt;reader();

	    while(&lt;$pipe&gt;) {
		...
	    }

	}
	elsif(defined $pid) { # Child
	    $pipe-&gt;writer();

	    print $pipe ...
	}

	or

	$pipe = IO::Pipe-&gt;new();

	$pipe-&gt;reader(qw(ls -l));

	while(&lt;$pipe&gt;) {
	    ...
	}

=head1 DESCRIPTION

C&lt;IO::Pipe&gt; provides an interface to creating pipes between
processes.

=head1 CONSTRUCTOR

=over 4

=item new ( [READER, WRITER] )

Creates an C&lt;IO::Pipe&gt;, which is a reference to a newly created symbol
(see the L&lt;Symbol&gt; package). C&lt;IO::Pipe::new&gt; optionally takes two
arguments, which should be objects blessed into C&lt;IO::Handle&gt;, or a
subclass thereof. These two objects will be used for the system call
to C&lt;pipe&gt;. If no arguments are given then method C&lt;handles&gt; is called
on the new C&lt;IO::Pipe&gt; object.

These two handles are held in the array part of the GLOB until either
C&lt;reader&gt; or C&lt;writer&gt; is called.

=back

=head1 METHODS

=over 4

=item reader ([ARGS])

The object is re-blessed into a sub-class of C&lt;IO::Handle&gt;, and becomes a
handle at the reading end of the pipe. If C&lt;ARGS&gt; are given then C&lt;fork&gt;
is called and C&lt;ARGS&gt; are passed to exec.

=item writer ([ARGS])

The object is re-blessed into a sub-class of C&lt;IO::Handle&gt;, and becomes a
handle at the writing end of the pipe. If C&lt;ARGS&gt; are given then C&lt;fork&gt;
is called and C&lt;ARGS&gt; are passed to exec.

=item handles ()

This method is called during construction by C&lt;IO::Pipe::new&gt;
on the newly created C&lt;IO::Pipe&gt; object. It returns an array of two objects
blessed into C&lt;IO::Pipe::End&gt;, or a subclass thereof.

=back

=head1 SEE ALSO

L&lt;IO::Handle&gt;

=head1 AUTHOR

Graham Barr. Currently maintained by the Perl Porters.  Please report all
bugs at L&lt;https://github.com/Perl/perl5/issues&gt;.

=head1 COPYRIGHT

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.

=cut
</pre></body></html>