xref: /openbsd-src/gnu/usr.bin/perl/dist/IO/lib/IO/Pipe.pm (revision 3d61058aa5c692477b6d18acfbbdb653a9930ff9)
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