Commit | Line | Data |
---|---|---|
920dae64 AT |
1 | # IO::Pipe.pm |
2 | # | |
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 | |
5 | # modify it under the same terms as Perl itself. | |
6 | ||
7 | package IO::Pipe; | |
8 | ||
9 | use 5.006_001; | |
10 | ||
11 | use IO::Handle; | |
12 | use strict; | |
13 | our($VERSION); | |
14 | use Carp; | |
15 | use Symbol; | |
16 | ||
17 | $VERSION = "1.13"; | |
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 | ||
41 | my $do_spawn = $^O eq 'os2' || $^O eq 'MSWin32'; | |
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); | |
59 | my $handle = shift; | |
60 | # Close in child: | |
61 | unless ($^O eq 'MSWin32') { | |
62 | fcntl($handle, Fcntl::F_SETFD(), 1) or croak "fcntl: $!"; | |
63 | } | |
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); | |
71 | $fh->close; | |
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 { | |
94 | @_ >= 1 or croak 'usage: $pipe->reader( [SUB_COMMAND_ARGS] )'; | |
95 | my $me = shift; | |
96 | ||
97 | return undef | |
98 | unless(ref($me) || ref($me = $me->new)); | |
99 | ||
100 | my $fh = ${*$me}[0]; | |
101 | my $pid; | |
102 | $pid = $me->_doit(0, $fh, @_) | |
103 | if(@_); | |
104 | ||
105 | close ${*$me}[1]; | |
106 | bless $me, ref($fh); | |
107 | *$me = *$fh; # Alias self to handle | |
108 | $me->fdopen($fh->fileno,"r") | |
109 | unless defined($me->fileno); | |
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 { | |
118 | @_ >= 1 or croak 'usage: $pipe->writer( [SUB_COMMAND_ARGS] )'; | |
119 | my $me = shift; | |
120 | ||
121 | return undef | |
122 | unless(ref($me) || ref($me = $me->new)); | |
123 | ||
124 | my $fh = ${*$me}[1]; | |
125 | my $pid; | |
126 | $pid = $me->_doit(1, $fh, @_) | |
127 | if(@_); | |
128 | ||
129 | close ${*$me}[0]; | |
130 | bless $me, ref($fh); | |
131 | *$me = *$fh; # Alias self to handle | |
132 | $me->fdopen($fh->fileno,"w") | |
133 | unless defined($me->fileno); | |
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 | ||
143 | our(@ISA); | |
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 | ||
161 | =head1 NAME | |
162 | ||
163 | IO::Pipe - supply object methods for pipes | |
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 | ||
174 | while(<$pipe>) { | |
175 | ... | |
176 | } | |
177 | ||
178 | } | |
179 | elsif(defined $pid) { # Child | |
180 | $pipe->writer(); | |
181 | ||
182 | print $pipe ... | |
183 | } | |
184 | ||
185 | or | |
186 | ||
187 | $pipe = new IO::Pipe; | |
188 | ||
189 | $pipe->reader(qw(ls -l)); | |
190 | ||
191 | while(<$pipe>) { | |
192 | ... | |
193 | } | |
194 | ||
195 | =head1 DESCRIPTION | |
196 | ||
197 | C<IO::Pipe> provides an interface to creating pipes between | |
198 | processes. | |
199 | ||
200 | =head1 CONSTRUCTOR | |
201 | ||
202 | =over 4 | |
203 | ||
204 | =item new ( [READER, WRITER] ) | |
205 | ||
206 | Creates an C<IO::Pipe>, which is a reference to a newly created symbol | |
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. | |
212 | ||
213 | These two handles are held in the array part of the GLOB until either | |
214 | C<reader> or C<writer> is called. | |
215 | ||
216 | =back | |
217 | ||
218 | =head1 METHODS | |
219 | ||
220 | =over 4 | |
221 | ||
222 | =item reader ([ARGS]) | |
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 | ||
228 | =item writer ([ARGS]) | |
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 | ||
234 | =item handles () | |
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 | |
238 | blessed into C<IO::Pipe::End>, or a subclass thereof. | |
239 | ||
240 | =back | |
241 | ||
242 | =head1 SEE ALSO | |
243 | ||
244 | L<IO::Handle> | |
245 | ||
246 | =head1 AUTHOR | |
247 | ||
248 | Graham Barr. Currently maintained by the Perl Porters. Please report all | |
249 | bugs to <perl5-porters@perl.org>. | |
250 | ||
251 | =head1 COPYRIGHT | |
252 | ||
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. | |
256 | ||
257 | =cut |