Commit | Line | Data |
8add82fc |
1 | # |
2 | |
3 | package IO::Pipe; |
4 | |
5 | =head1 NAME |
6 | |
7e1af8bc |
7 | IO::Pipe - supply object methods for pipes |
8add82fc |
8 | |
9 | =head1 SYNOPSIS |
10 | |
11 | use IO::Pipe; |
12 | |
13 | $pipe = new IO::Pipe; |
14 | |
15 | if($pid = fork()) { # Parent |
16 | $pipe->reader(); |
17 | |
18 | while(<$pipe> { |
19 | .... |
20 | } |
21 | |
22 | } |
23 | elsif(defined $pid) { # Child |
24 | $pipe->writer(); |
25 | |
26 | print $pipe .... |
27 | } |
28 | |
29 | or |
30 | |
31 | $pipe = new IO::Pipe; |
32 | |
33 | $pipe->reader(qw(ls -l)); |
34 | |
35 | while(<$pipe>) { |
36 | .... |
37 | } |
38 | |
39 | =head1 DESCRIPTION |
40 | |
27d4819a |
41 | C<IO::Pipe> provides an interface to createing pipes between |
42 | processes. |
43 | |
44 | =head1 CONSTRCUTOR |
45 | |
46 | =over 4 |
47 | |
48 | =item new ( [READER, WRITER] ) |
49 | |
50 | Creates a C<IO::Pipe>, which is a reference to a |
8add82fc |
51 | newly created symbol (see the C<Symbol> package). C<IO::Pipe::new> |
52 | optionally takes two arguments, which should be objects blessed into |
53 | C<IO::Handle>, or a subclass thereof. These two objects will be used |
54 | for the system call to C<pipe>. If no arguments are given then then |
55 | method C<handles> is called on the new C<IO::Pipe> object. |
56 | |
27d4819a |
57 | These two handles are held in the array part of the GLOB until either |
8add82fc |
58 | C<reader> or C<writer> is called. |
59 | |
27d4819a |
60 | =back |
61 | |
62 | =head1 METHODS |
63 | |
64 | =over 4 |
8add82fc |
65 | |
27d4819a |
66 | =item reader ([ARGS]) |
8add82fc |
67 | |
68 | The object is re-blessed into a sub-class of C<IO::Handle>, and becomes a |
69 | handle at the reading end of the pipe. If C<ARGS> are given then C<fork> |
70 | is called and C<ARGS> are passed to exec. |
71 | |
27d4819a |
72 | =item writer ([ARGS]) |
8add82fc |
73 | |
74 | The object is re-blessed into a sub-class of C<IO::Handle>, and becomes a |
75 | handle at the writing end of the pipe. If C<ARGS> are given then C<fork> |
76 | is called and C<ARGS> are passed to exec. |
77 | |
27d4819a |
78 | =item handles () |
8add82fc |
79 | |
80 | This method is called during construction by C<IO::Pipe::new> |
81 | on the newly created C<IO::Pipe> object. It returns an array of two objects |
82 | blessed into C<IO::Handle>, or a subclass thereof. |
83 | |
84 | =back |
85 | |
86 | =head1 SEE ALSO |
87 | |
88 | L<IO::Handle> |
89 | |
90 | =head1 AUTHOR |
91 | |
27d4819a |
92 | Graham Barr E<lt>F<bodg@tiuk.ti.com>E<gt> |
8add82fc |
93 | |
94 | =head1 REVISION |
95 | |
27d4819a |
96 | $Revision: 1.7 $ |
8add82fc |
97 | |
98 | =head1 COPYRIGHT |
99 | |
100 | Copyright (c) 1995 Graham Barr. All rights reserved. This program is free |
101 | software; you can redistribute it and/or modify it under the same terms |
102 | as Perl itself. |
103 | |
104 | =cut |
105 | |
106 | require 5.000; |
107 | use vars qw($VERSION); |
108 | use Carp; |
109 | use Symbol; |
110 | require IO::Handle; |
111 | |
27d4819a |
112 | $VERSION = sprintf("%d.%02d", q$Revision: 1.7 $ =~ /(\d+)\.(\d+)/); |
8add82fc |
113 | |
114 | sub new { |
27d4819a |
115 | my $type = shift; |
116 | my $class = ref($type) || $type || "IO::Pipe"; |
117 | @_ == 0 || @_ == 2 or croak "usage: new $class [READFH, WRITEFH]"; |
8add82fc |
118 | |
27d4819a |
119 | my $me = bless gensym(), $class; |
8add82fc |
120 | |
121 | my($readfh,$writefh) = @_ ? @_ : $me->handles; |
122 | |
123 | pipe($readfh, $writefh) |
124 | or return undef; |
125 | |
126 | @{*$me} = ($readfh, $writefh); |
127 | |
128 | $me; |
129 | } |
130 | |
131 | sub handles { |
132 | @_ == 1 or croak 'usage: $pipe->handles()'; |
133 | (IO::Handle->new(), IO::Handle->new()); |
134 | } |
135 | |
136 | sub _doit { |
137 | my $me = shift; |
138 | my $rw = shift; |
139 | |
140 | my $pid = fork(); |
141 | |
142 | if($pid) { # Parent |
143 | return $pid; |
144 | } |
145 | elsif(defined $pid) { # Child |
146 | my $fh = $rw ? $me->reader() : $me->writer(); |
147 | my $io = $rw ? \*STDIN : \*STDOUT; |
148 | |
149 | bless $io, "IO::Handle"; |
150 | $io->fdopen($fh, $rw ? "r" : "w"); |
151 | exec @_ or |
152 | croak "IO::Pipe: Cannot exec: $!"; |
153 | } |
154 | else { |
155 | croak "IO::Pipe: Cannot fork: $!"; |
156 | } |
157 | |
158 | # NOT Reached |
159 | } |
160 | |
161 | sub reader { |
162 | @_ >= 1 or croak 'usage: $pipe->reader()'; |
163 | my $me = shift; |
164 | my $fh = ${*$me}[0]; |
165 | my $pid = $me->_doit(0,@_) |
166 | if(@_); |
167 | |
168 | bless $me, ref($fh); |
169 | *{*$me} = *{*$fh}; # Alias self to handle |
27d4819a |
170 | bless $fh; # Really wan't un-bless here |
8add82fc |
171 | ${*$me}{'io_pipe_pid'} = $pid |
172 | if defined $pid; |
173 | |
174 | $me; |
175 | } |
176 | |
177 | sub writer { |
178 | @_ >= 1 or croak 'usage: $pipe->writer()'; |
179 | my $me = shift; |
180 | my $fh = ${*$me}[1]; |
181 | my $pid = $me->_doit(1,@_) |
182 | if(@_); |
183 | |
184 | bless $me, ref($fh); |
185 | *{*$me} = *{*$fh}; # Alias self to handle |
27d4819a |
186 | bless $fh; # Really wan't un-bless here |
8add82fc |
187 | ${*$me}{'io_pipe_pid'} = $pid |
188 | if defined $pid; |
189 | |
190 | $me; |
191 | } |
192 | |
193 | 1; |
194 | |