This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
27fe7f1aa21c4b29b0f52bb68f6f1525c142be0f
[perl5.git] / ext / IO / lib / IO / Pipe.pm
1 #
2
3 package IO::Pipe;
4
5 =head1 NAME
6
7 IO::pipe - supply object methods for pipes
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
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
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
57 These two handles are held in the array part of the GLOB until either
58 C<reader> or C<writer> is called.
59
60 =back
61
62 =head1 METHODS
63
64 =over 4
65
66 =item reader ([ARGS])
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
72 =item writer ([ARGS])
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
78 =item handles ()
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
92 Graham Barr E<lt>F<bodg@tiuk.ti.com>E<gt>
93
94 =head1 REVISION
95
96 $Revision: 1.7 $
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
112 $VERSION = sprintf("%d.%02d", q$Revision: 1.7 $ =~ /(\d+)\.(\d+)/);
113
114 sub new {
115     my $type = shift;
116     my $class = ref($type) || $type || "IO::Pipe";
117     @_ == 0 || @_ == 2 or croak "usage: new $class [READFH, WRITEFH]";
118
119     my $me = bless gensym(), $class;
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
170     bless $fh;                  # Really wan't un-bless here
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
186     bless $fh;                  # Really wan't un-bless here
187     ${*$me}{'io_pipe_pid'} = $pid
188         if defined $pid;
189
190     $me;
191 }
192
193 1;
194