This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perl 5.003_01: [changes beteween cumulative patches and tarball release]
[perl5.git] / ext / IO / lib / IO / Select.pm
CommitLineData
8add82fc
PP
1# IO::Select.pm
2
3package IO::Select;
4
5=head1 NAME
6
7IO::Select - OO interface to the system select call
8
9=head1 SYNOPSYS
10
11 use IO::Select;
12
13 $s = IO::Select->new();
14
15 $s->add(\*STDIN);
16 $s->add($some_handle);
17
18 @ready = $s->can_read($timeout);
19
20 @ready = IO::Select->new(@handles)->read(0);
21
22=head1 DESCRIPTION
23
24The C<IO::Select> package implements an object approach to the system C<select>
25function call. It allows the user to see what IO handles, see L<IO::Handle>,
26are ready for reading, writing or have an error condition pending.
27
28=head1 CONSTRUCTOR
29
30=over 4
31
32=item new ( [ HANDLES ] )
33
34The constructor create a new object and optionally initialises it with a set
35of handles.
36
37=back
38
39=head1 METHODS
40
41=over 4
42
43=item add ( HANDLES )
44
45Add the list of handles to the C<IO::Select> object. It is these values that
46will be returned when an event occurs. C<IO::Select> keeps these values in a
47cache which is indexed by the C<fileno> of the handle, so if more than one
48handle with the same C<fileno> is specified then only the last one is cached.
49
50=item remove ( HANDLES )
51
52Remove all the given handles from the object.
53
54=item can_read ( [ TIMEOUT ] )
55
56Return an array of handles that are ready for reading. C<TIMEOUT> is the maximum
57amount of time to wait before returning an empty list. If C<TIMEOUT> is
58not given then the call will block.
59
60=item can_write ( [ TIMEOUT ] )
61
62Same as C<can_read> except check for handles that can be written to.
63
64=item has_error ( [ TIMEOUT ] )
65
66Same as C<can_read> except check for handles that have an error condition, for
67example EOF.
68
69=item select ( READ, WRITE, ERROR [, TIMEOUT ] )
70
71C<select> is a static method, that is you call it with the package name
72like C<new>. C<READ>, C<WRITE> and C<ERROR> are either C<undef> or
73C<IO::Select> objects. C<TIMEOUT> is optional and has the same effect as
74before.
75
76The result will be an array of 3 elements, each a reference to an array
77which will hold the handles that are ready for reading, writing and have
78error conditions respectively. Upon error an empty array is returned.
79
80=back
81
82=head1 EXAMPLE
83
84Here is a short example which shows how C<IO::Select> could be used
85to write a server which communicates with several sockets while also
86listening for more connections on a listen socket
87
88 use IO::Select;
89 use IO::Socket;
90
91 $lsn = new IO::Socket::INET(Listen => 1, LocalPort => 8080);
92 $sel = new IO::Select( $lsn );
93
94 while(@ready = $sel->can_read) {
95 foreach $fh (@ready) {
96 if($fh == $lsn) {
97 # Create a new socket
98 $new = $lsn->accept;
99 $sel->add($new);
100 }
101 else {
102 # Process socket
103
104 # Maybe we have finished with the socket
105 $sel->remove($fh);
106 $fh->close;
107 }
108 }
109 }
110
111=head1 AUTHOR
112
113Graham Barr <Graham.Barr@tiuk.ti.com>
114
115=head1 REVISION
116
117$Revision: 1.2 $
118
119=head1 COPYRIGHT
120
121Copyright (c) 1995 Graham Barr. All rights reserved. This program is free
122software; you can redistribute it and/or modify it under the same terms
123as Perl itself.
124
125=cut
126
127use strict;
128use vars qw($VERSION @ISA);
129require Exporter;
130
131$VERSION = sprintf("%d.%02d", q$Revision: 1.2 $ =~ /(\d+)\.(\d+)/);
132
133@ISA = qw(Exporter); # This is only so we can do version checking
134
135sub new
136{
137 my $self = shift;
138 my $type = ref($self) || $self;
139
140 my $vec = bless [''], $type;
141
142 $vec->add(@_)
143 if @_;
144
145 $vec;
146}
147
148sub add
149{
150 my $vec = shift;
151 my $f;
152
153 foreach $f (@_)
154 {
155 my $fn = $f =~ /^\d+$/ ? $f : fileno($f);
156 next
157 unless defined $fn;
158 vec($vec->[0],$fn++,1) = 1;
159 $vec->[$fn] = $f;
160 }
161}
162
163sub remove
164{
165 my $vec = shift;
166 my $f;
167
168 foreach $f (@_)
169 {
170 my $fn = $f =~ /^\d+$/ ? $f : fileno($f);
171 next
172 unless defined $fn;
173 vec($vec->[0],$fn++,1) = 0;
174 $vec->[$fn] = undef;
175 }
176}
177
178sub can_read
179{
180 my $vec = shift;
181 my $timeout = shift;
182
183 my $r = $vec->[0];
184
185 select($r,undef,undef,$timeout) > 0
186 ? _handles($vec, $r)
187 : ();
188}
189
190sub can_write
191{
192 my $vec = shift;
193 my $timeout = shift;
194
195 my $w = $vec->[0];
196
197 select(undef,$w,undef,$timeout) > 0
198 ? _handles($vec, $w)
199 : ();
200}
201
202sub has_error
203{
204 my $vec = shift;
205 my $timeout = shift;
206
207 my $e = $vec->[0];
208
209 select(undef,undef,$e,$timeout) > 0
210 ? _handles($vec, $e)
211 : ();
212}
213
214sub _max
215{
216 my($a,$b,$c) = @_;
217 $a > $b
218 ? $a > $c
219 ? $a
220 : $c
221 : $b > $c
222 ? $b
223 : $c;
224}
225
226sub select
227{
228 shift
229 if defined $_[0] && !ref($_[0]);
230
231 my($r,$w,$e,$t) = @_;
232 my @result = ();
233
234 my $rb = defined $r ? $r->[0] : undef;
235 my $wb = defined $w ? $e->[0] : undef;
236 my $eb = defined $e ? $w->[0] : undef;
237
238 if(select($rb,$wb,$eb,$t) > 0)
239 {
240 my @r = ();
241 my @w = ();
242 my @e = ();
243 my $i = _max(defined $r ? scalar(@$r) : 0,
244 defined $w ? scalar(@$w) : 0,
245 defined $e ? scalar(@$e) : 0);
246
247 for( ; $i > 0 ; $i--)
248 {
249 my $j = $i - 1;
250 push(@r, $r->[$i])
251 if defined $r->[$i] && vec($rb, $j, 1);
252 push(@w, $w->[$i])
253 if defined $w->[$i] && vec($wb, $j, 1);
254 push(@e, $e->[$i])
255 if defined $e->[$i] && vec($eb, $j, 1);
256 }
257
258 @result = (\@r, \@w, \@e);
259 }
260 @result;
261}
262
263sub _handles
264{
265 my $vec = shift;
266 my $bits = shift;
267 my @h = ();
268 my $i;
269
270 for($i = scalar(@$vec) - 1 ; $i > 0 ; $i--)
271 {
272 next unless defined $vec->[$i];
273 push(@h, $vec->[$i])
274 if vec($bits,$i - 1,1);
275 }
276
277 @h;
278}
279
2801;