Commit | Line | Data |
774d564b |
1 | # IO::Pipe.pm |
8add82fc |
2 | # |
cf7fe8a2 |
3 | # Copyright (c) 1996-8 Graham Barr <gbarr@pobox.com>. All rights reserved. |
4 | # This program is free software; you can redistribute it and/or |
774d564b |
5 | # modify it under the same terms as Perl itself. |
8add82fc |
6 | |
7 | package IO::Pipe; |
8 | |
3b825e41 |
9 | use 5.006_001; |
774d564b |
10 | |
11 | use IO::Handle; |
12 | use strict; |
17f410f9 |
13 | our($VERSION); |
774d564b |
14 | use Carp; |
15 | use Symbol; |
16 | |
b0cb64b6 |
17 | $VERSION = "1.122"; |
774d564b |
18 | |
19 | sub new { |
20 | my $type = shift; |
21 | my $class = ref($type) || $type || "IO::Pipe"; |
22 | @_ == 0 || @_ == 2 or croak "usage: new $class [READFH, WRITEFH]"; |
23 | |
24 | my $me = bless gensym(), $class; |
25 | |
26 | my($readfh,$writefh) = @_ ? @_ : $me->handles; |
27 | |
28 | pipe($readfh, $writefh) |
29 | or return undef; |
30 | |
31 | @{*$me} = ($readfh, $writefh); |
32 | |
33 | $me; |
34 | } |
35 | |
36 | sub handles { |
37 | @_ == 1 or croak 'usage: $pipe->handles()'; |
38 | (IO::Pipe::End->new(), IO::Pipe::End->new()); |
39 | } |
40 | |
ae63fb94 |
41 | my $do_spawn = $^O eq 'os2' || $^O eq 'MSWin32'; |
774d564b |
42 | |
43 | sub _doit { |
44 | my $me = shift; |
45 | my $rw = shift; |
46 | |
47 | my $pid = $do_spawn ? 0 : fork(); |
48 | |
49 | if($pid) { # Parent |
50 | return $pid; |
51 | } |
52 | elsif(defined $pid) { # Child or spawn |
53 | my $fh; |
54 | my $io = $rw ? \*STDIN : \*STDOUT; |
55 | my ($mode, $save) = $rw ? "r" : "w"; |
56 | if ($do_spawn) { |
57 | require Fcntl; |
58 | $save = IO::Handle->new_from_fd($io, $mode); |
ae63fb94 |
59 | my $handle = shift; |
774d564b |
60 | # Close in child: |
ae63fb94 |
61 | unless ($^O eq 'MSWin32') { |
62 | fcntl($handle, Fcntl::F_SETFD(), 1) or croak "fcntl: $!"; |
63 | } |
774d564b |
64 | $fh = $rw ? ${*$me}[0] : ${*$me}[1]; |
65 | } else { |
66 | shift; |
67 | $fh = $rw ? $me->reader() : $me->writer(); # close the other end |
68 | } |
69 | bless $io, "IO::Handle"; |
70 | $io->fdopen($fh, $mode); |
cf7fe8a2 |
71 | $fh->close; |
774d564b |
72 | |
73 | if ($do_spawn) { |
74 | $pid = eval { system 1, @_ }; # 1 == P_NOWAIT |
75 | my $err = $!; |
76 | |
77 | $io->fdopen($save, $mode); |
78 | $save->close or croak "Cannot close $!"; |
79 | croak "IO::Pipe: Cannot spawn-NOWAIT: $err" if not $pid or $pid < 0; |
80 | return $pid; |
81 | } else { |
82 | exec @_ or |
83 | croak "IO::Pipe: Cannot exec: $!"; |
84 | } |
85 | } |
86 | else { |
87 | croak "IO::Pipe: Cannot fork: $!"; |
88 | } |
89 | |
90 | # NOT Reached |
91 | } |
92 | |
93 | sub reader { |
cf7fe8a2 |
94 | @_ >= 1 or croak 'usage: $pipe->reader( [SUB_COMMAND_ARGS] )'; |
774d564b |
95 | my $me = shift; |
cf7fe8a2 |
96 | |
97 | return undef |
98 | unless(ref($me) || ref($me = $me->new)); |
99 | |
774d564b |
100 | my $fh = ${*$me}[0]; |
76df5e8f |
101 | my $pid; |
102 | $pid = $me->_doit(0, $fh, @_) |
774d564b |
103 | if(@_); |
104 | |
105 | close ${*$me}[1]; |
106 | bless $me, ref($fh); |
cf340197 |
107 | *$me = *$fh; # Alias self to handle |
cf7fe8a2 |
108 | $me->fdopen($fh->fileno,"r") |
109 | unless defined($me->fileno); |
774d564b |
110 | bless $fh; # Really wan't un-bless here |
111 | ${*$me}{'io_pipe_pid'} = $pid |
112 | if defined $pid; |
113 | |
114 | $me; |
115 | } |
116 | |
117 | sub writer { |
cf7fe8a2 |
118 | @_ >= 1 or croak 'usage: $pipe->writer( [SUB_COMMAND_ARGS] )'; |
774d564b |
119 | my $me = shift; |
cf7fe8a2 |
120 | |
121 | return undef |
122 | unless(ref($me) || ref($me = $me->new)); |
123 | |
774d564b |
124 | my $fh = ${*$me}[1]; |
76df5e8f |
125 | my $pid; |
126 | $pid = $me->_doit(1, $fh, @_) |
774d564b |
127 | if(@_); |
128 | |
129 | close ${*$me}[0]; |
130 | bless $me, ref($fh); |
cf340197 |
131 | *$me = *$fh; # Alias self to handle |
cf7fe8a2 |
132 | $me->fdopen($fh->fileno,"w") |
133 | unless defined($me->fileno); |
774d564b |
134 | bless $fh; # Really wan't un-bless here |
135 | ${*$me}{'io_pipe_pid'} = $pid |
136 | if defined $pid; |
137 | |
138 | $me; |
139 | } |
140 | |
141 | package IO::Pipe::End; |
142 | |
17f410f9 |
143 | our(@ISA); |
774d564b |
144 | |
145 | @ISA = qw(IO::Handle); |
146 | |
147 | sub close { |
148 | my $fh = shift; |
149 | my $r = $fh->SUPER::close(@_); |
150 | |
151 | waitpid(${*$fh}{'io_pipe_pid'},0) |
152 | if(defined ${*$fh}{'io_pipe_pid'}); |
153 | |
154 | $r; |
155 | } |
156 | |
157 | 1; |
158 | |
159 | __END__ |
160 | |
8add82fc |
161 | =head1 NAME |
162 | |
cf7fe8a2 |
163 | IO::Pipe - supply object methods for pipes |
8add82fc |
164 | |
165 | =head1 SYNOPSIS |
166 | |
167 | use IO::Pipe; |
168 | |
169 | $pipe = new IO::Pipe; |
170 | |
171 | if($pid = fork()) { # Parent |
172 | $pipe->reader(); |
173 | |
ddbf9127 |
174 | while(<$pipe>) { |
175 | ... |
8add82fc |
176 | } |
177 | |
178 | } |
179 | elsif(defined $pid) { # Child |
180 | $pipe->writer(); |
181 | |
ddbf9127 |
182 | print $pipe ... |
8add82fc |
183 | } |
184 | |
185 | or |
186 | |
187 | $pipe = new IO::Pipe; |
188 | |
189 | $pipe->reader(qw(ls -l)); |
190 | |
191 | while(<$pipe>) { |
ddbf9127 |
192 | ... |
8add82fc |
193 | } |
194 | |
195 | =head1 DESCRIPTION |
196 | |
de592821 |
197 | C<IO::Pipe> provides an interface to creating pipes between |
27d4819a |
198 | processes. |
199 | |
de592821 |
200 | =head1 CONSTRUCTOR |
27d4819a |
201 | |
202 | =over 4 |
203 | |
204 | =item new ( [READER, WRITER] ) |
205 | |
d1be9408 |
206 | Creates an C<IO::Pipe>, which is a reference to a newly created symbol |
7a2e2cd6 |
207 | (see the C<Symbol> package). C<IO::Pipe::new> optionally takes two |
208 | arguments, which should be objects blessed into C<IO::Handle>, or a |
209 | subclass thereof. These two objects will be used for the system call |
210 | to C<pipe>. If no arguments are given then method C<handles> is called |
211 | on the new C<IO::Pipe> object. |
8add82fc |
212 | |
27d4819a |
213 | These two handles are held in the array part of the GLOB until either |
8add82fc |
214 | C<reader> or C<writer> is called. |
215 | |
27d4819a |
216 | =back |
217 | |
218 | =head1 METHODS |
219 | |
220 | =over 4 |
8add82fc |
221 | |
27d4819a |
222 | =item reader ([ARGS]) |
8add82fc |
223 | |
224 | The object is re-blessed into a sub-class of C<IO::Handle>, and becomes a |
225 | handle at the reading end of the pipe. If C<ARGS> are given then C<fork> |
226 | is called and C<ARGS> are passed to exec. |
227 | |
27d4819a |
228 | =item writer ([ARGS]) |
8add82fc |
229 | |
230 | The object is re-blessed into a sub-class of C<IO::Handle>, and becomes a |
231 | handle at the writing end of the pipe. If C<ARGS> are given then C<fork> |
232 | is called and C<ARGS> are passed to exec. |
233 | |
27d4819a |
234 | =item handles () |
8add82fc |
235 | |
236 | This method is called during construction by C<IO::Pipe::new> |
237 | on the newly created C<IO::Pipe> object. It returns an array of two objects |
774d564b |
238 | blessed into C<IO::Pipe::End>, or a subclass thereof. |
8add82fc |
239 | |
240 | =back |
241 | |
242 | =head1 SEE ALSO |
243 | |
244 | L<IO::Handle> |
245 | |
246 | =head1 AUTHOR |
247 | |
854822f1 |
248 | Graham Barr. Currently maintained by the Perl Porters. Please report all |
249 | bugs to <perl5-porters@perl.org>. |
8add82fc |
250 | |
251 | =head1 COPYRIGHT |
252 | |
cf7fe8a2 |
253 | Copyright (c) 1996-8 Graham Barr <gbarr@pobox.com>. All rights reserved. |
254 | This program is free software; you can redistribute it and/or |
255 | modify it under the same terms as Perl itself. |
8add82fc |
256 | |
257 | =cut |