This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #75156] fix the return value and bits for removing a closed fh
[perl5.git] / dist / IO / lib / IO / Select.pm
CommitLineData
8add82fc 1# IO::Select.pm
7a4c00b4 2#
cf7fe8a2
GS
3# Copyright (c) 1997-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.
8add82fc
PP
6
7package IO::Select;
8
8add82fc 9use strict;
d3a7d8c7 10use warnings::register;
8add82fc
PP
11use vars qw($VERSION @ISA);
12require Exporter;
13
ff4a442c 14$VERSION = "1.22";
8add82fc
PP
15
16@ISA = qw(Exporter); # This is only so we can do version checking
17
7a4c00b4
PP
18sub VEC_BITS () {0}
19sub FD_COUNT () {1}
20sub FIRST_FD () {2}
760ac839 21
8add82fc
PP
22sub new
23{
24 my $self = shift;
25 my $type = ref($self) || $self;
26
760ac839 27 my $vec = bless [undef,0], $type;
8add82fc
PP
28
29 $vec->add(@_)
30 if @_;
31
32 $vec;
33}
34
35sub add
36{
7a4c00b4
PP
37 shift->_update('add', @_);
38}
39
40
41sub remove
42{
43 shift->_update('remove', @_);
44}
45
46
47sub exists
48{
8add82fc 49 my $vec = shift;
4fdd9276
GS
50 my $fno = $vec->_fileno(shift);
51 return undef unless defined $fno;
52 $vec->[$fno + FIRST_FD];
7a4c00b4 53}
8add82fc 54
760ac839 55
7a4c00b4
PP
56sub _fileno
57{
58 my($self, $f) = @_;
da7f16d7 59 return unless defined $f;
7a4c00b4
PP
60 $f = $f->[0] if ref($f) eq 'ARRAY';
61 ($f =~ /^\d+$/) ? $f : fileno($f);
8add82fc
PP
62}
63
7a4c00b4 64sub _update
8add82fc
PP
65{
66 my $vec = shift;
7a4c00b4 67 my $add = shift eq 'add';
8add82fc 68
7a4c00b4
PP
69 my $bits = $vec->[VEC_BITS];
70 $bits = '' unless defined $bits;
71
72 my $count = 0;
73 my $f;
8add82fc
PP
74 foreach $f (@_)
75 {
7a4c00b4 76 my $fn = $vec->_fileno($f);
7a4c00b4 77 if ($add) {
2e6546ca
FF
78 next unless defined $fn;
79 my $i = $fn + FIRST_FD;
7a4c00b4
PP
80 if (defined $vec->[$i]) {
81 $vec->[$i] = $f; # if array rest might be different, so we update
82 next;
83 }
84 $vec->[FD_COUNT]++;
85 vec($bits, $fn, 1) = 1;
86 $vec->[$i] = $f;
87 } else { # remove
2e6546ca 88 if ( ! defined $fn ) { # remove if fileno undef'd
ff4a442c
TC
89 $fn = 0;
90 for my $fe (@{$vec}[FIRST_FD .. $#$vec]) {
91 if (defined($fe) && $fe == $f) {
92 $vec->[FD_COUNT]--;
93 $fe = undef;
94 vec($bits, $fn, 1) = 0;
95 last;
96 }
97 ++$fn;
98 }
99 }
100 else {
101 my $i = $fn + FIRST_FD;
102 next unless defined $vec->[$i];
103 $vec->[FD_COUNT]--;
104 vec($bits, $fn, 1) = 0;
105 $vec->[$i] = undef;
2e6546ca 106 }
7a4c00b4
PP
107 }
108 $count++;
8add82fc 109 }
7a4c00b4
PP
110 $vec->[VEC_BITS] = $vec->[FD_COUNT] ? $bits : undef;
111 $count;
8add82fc
PP
112}
113
114sub can_read
115{
116 my $vec = shift;
117 my $timeout = shift;
27d4819a 118 my $r = $vec->[VEC_BITS];
8add82fc 119
27d4819a 120 defined($r) && (select($r,undef,undef,$timeout) > 0)
7a4c00b4 121 ? handles($vec, $r)
8add82fc
PP
122 : ();
123}
124
125sub can_write
126{
127 my $vec = shift;
128 my $timeout = shift;
27d4819a 129 my $w = $vec->[VEC_BITS];
8add82fc 130
27d4819a 131 defined($w) && (select(undef,$w,undef,$timeout) > 0)
7a4c00b4 132 ? handles($vec, $w)
8add82fc
PP
133 : ();
134}
135
cf7fe8a2 136sub has_exception
8add82fc
PP
137{
138 my $vec = shift;
139 my $timeout = shift;
27d4819a 140 my $e = $vec->[VEC_BITS];
8add82fc 141
27d4819a 142 defined($e) && (select(undef,undef,$e,$timeout) > 0)
7a4c00b4 143 ? handles($vec, $e)
8add82fc
PP
144 : ();
145}
146
cf7fe8a2
GS
147sub has_error
148{
6facdfff 149 warnings::warn("Call to deprecated method 'has_error', use 'has_exception'")
d3a7d8c7 150 if warnings::enabled();
cf7fe8a2
GS
151 goto &has_exception;
152}
153
760ac839
LW
154sub count
155{
156 my $vec = shift;
157 $vec->[FD_COUNT];
158}
159
7a4c00b4
PP
160sub bits
161{
162 my $vec = shift;
163 $vec->[VEC_BITS];
164}
165
166sub as_string # for debugging
167{
168 my $vec = shift;
169 my $str = ref($vec) . ": ";
170 my $bits = $vec->bits;
171 my $count = $vec->count;
172 $str .= defined($bits) ? unpack("b*", $bits) : "undef";
173 $str .= " $count";
174 my @handles = @$vec;
175 splice(@handles, 0, FIRST_FD);
176 for (@handles) {
177 $str .= " " . (defined($_) ? "$_" : "-");
178 }
179 $str;
180}
181
8add82fc
PP
182sub _max
183{
184 my($a,$b,$c) = @_;
185 $a > $b
186 ? $a > $c
187 ? $a
188 : $c
189 : $b > $c
190 ? $b
191 : $c;
192}
193
194sub select
195{
196 shift
197 if defined $_[0] && !ref($_[0]);
198
199 my($r,$w,$e,$t) = @_;
200 my @result = ();
201
760ac839 202 my $rb = defined $r ? $r->[VEC_BITS] : undef;
7a4c00b4
PP
203 my $wb = defined $w ? $w->[VEC_BITS] : undef;
204 my $eb = defined $e ? $e->[VEC_BITS] : undef;
8add82fc
PP
205
206 if(select($rb,$wb,$eb,$t) > 0)
207 {
208 my @r = ();
209 my @w = ();
210 my @e = ();
760ac839
LW
211 my $i = _max(defined $r ? scalar(@$r)-1 : 0,
212 defined $w ? scalar(@$w)-1 : 0,
213 defined $e ? scalar(@$e)-1 : 0);
8add82fc 214
760ac839 215 for( ; $i >= FIRST_FD ; $i--)
8add82fc 216 {
760ac839 217 my $j = $i - FIRST_FD;
8add82fc 218 push(@r, $r->[$i])
760ac839 219 if defined $rb && defined $r->[$i] && vec($rb, $j, 1);
8add82fc 220 push(@w, $w->[$i])
760ac839 221 if defined $wb && defined $w->[$i] && vec($wb, $j, 1);
8add82fc 222 push(@e, $e->[$i])
760ac839 223 if defined $eb && defined $e->[$i] && vec($eb, $j, 1);
8add82fc
PP
224 }
225
226 @result = (\@r, \@w, \@e);
227 }
228 @result;
229}
230
7a4c00b4
PP
231
232sub handles
8add82fc
PP
233{
234 my $vec = shift;
235 my $bits = shift;
236 my @h = ();
237 my $i;
7a4c00b4 238 my $max = scalar(@$vec) - 1;
8add82fc 239
7a4c00b4 240 for ($i = FIRST_FD; $i <= $max; $i++)
8add82fc
PP
241 {
242 next unless defined $vec->[$i];
243 push(@h, $vec->[$i])
7a4c00b4 244 if !defined($bits) || vec($bits, $i - FIRST_FD, 1);
8add82fc
PP
245 }
246
247 @h;
248}
249
2501;
cf7fe8a2
GS
251__END__
252
253=head1 NAME
254
255IO::Select - OO interface to the select system call
256
257=head1 SYNOPSIS
258
259 use IO::Select;
260
261 $s = IO::Select->new();
262
263 $s->add(\*STDIN);
264 $s->add($some_handle);
265
266 @ready = $s->can_read($timeout);
267
5929cfd6 268 @ready = IO::Select->new(@handles)->can_read(0);
cf7fe8a2
GS
269
270=head1 DESCRIPTION
271
272The C<IO::Select> package implements an object approach to the system C<select>
273function call. It allows the user to see what IO handles, see L<IO::Handle>,
5929cfd6 274are ready for reading, writing or have an exception pending.
cf7fe8a2
GS
275
276=head1 CONSTRUCTOR
277
278=over 4
279
280=item new ( [ HANDLES ] )
281
282The constructor creates a new object and optionally initialises it with a set
283of handles.
284
285=back
286
287=head1 METHODS
288
289=over 4
290
291=item add ( HANDLES )
292
293Add the list of handles to the C<IO::Select> object. It is these values that
294will be returned when an event occurs. C<IO::Select> keeps these values in a
295cache which is indexed by the C<fileno> of the handle, so if more than one
296handle with the same C<fileno> is specified then only the last one is cached.
297
298Each handle can be an C<IO::Handle> object, an integer or an array
d1be9408 299reference where the first element is an C<IO::Handle> or an integer.
cf7fe8a2
GS
300
301=item remove ( HANDLES )
302
303Remove all the given handles from the object. This method also works
304by the C<fileno> of the handles. So the exact handles that were added
305need not be passed, just handles that have an equivalent C<fileno>
306
307=item exists ( HANDLE )
308
309Returns a true value (actually the handle itself) if it is present.
310Returns undef otherwise.
311
312=item handles
313
314Return an array of all registered handles.
315
316=item can_read ( [ TIMEOUT ] )
317
318Return an array of handles that are ready for reading. C<TIMEOUT> is
8971464f
JH
319the maximum amount of time to wait before returning an empty list, in
320seconds, possibly fractional. If C<TIMEOUT> is not given and any
321handles are registered then the call will block.
cf7fe8a2
GS
322
323=item can_write ( [ TIMEOUT ] )
324
325Same as C<can_read> except check for handles that can be written to.
326
327=item has_exception ( [ TIMEOUT ] )
328
329Same as C<can_read> except check for handles that have an exception
330condition, for example pending out-of-band data.
331
332=item count ()
333
334Returns the number of handles that the object will check for when
335one of the C<can_> methods is called or the object is passed to
336the C<select> static method.
337
338=item bits()
339
340Return the bit string suitable as argument to the core select() call.
341
5929cfd6 342=item select ( READ, WRITE, EXCEPTION [, TIMEOUT ] )
cf7fe8a2 343
5929cfd6
RS
344C<select> is a static method, that is you call it with the package name
345like C<new>. C<READ>, C<WRITE> and C<EXCEPTION> are either C<undef> or
346C<IO::Select> objects. C<TIMEOUT> is optional and has the same effect as
347for the core select call.
cf7fe8a2
GS
348
349The result will be an array of 3 elements, each a reference to an array
350which will hold the handles that are ready for reading, writing and have
5929cfd6 351exceptions respectively. Upon error an empty list is returned.
cf7fe8a2
GS
352
353=back
354
355=head1 EXAMPLE
356
357Here is a short example which shows how C<IO::Select> could be used
358to write a server which communicates with several sockets while also
359listening for more connections on a listen socket
360
361 use IO::Select;
362 use IO::Socket;
363
f00d3350
BR
364 $lsn = IO::Socket::INET->new(Listen => 1, LocalPort => 8080);
365 $sel = IO::Select->new( $lsn );
3cb6de81 366
cf7fe8a2
GS
367 while(@ready = $sel->can_read) {
368 foreach $fh (@ready) {
369 if($fh == $lsn) {
370 # Create a new socket
371 $new = $lsn->accept;
372 $sel->add($new);
373 }
374 else {
375 # Process socket
376
377 # Maybe we have finished with the socket
378 $sel->remove($fh);
379 $fh->close;
380 }
381 }
382 }
383
384=head1 AUTHOR
385
854822f1 386Graham Barr. Currently maintained by the Perl Porters. Please report all
9f7d1e40 387bugs to <perlbug@perl.org>.
cf7fe8a2
GS
388
389=head1 COPYRIGHT
390
391Copyright (c) 1997-8 Graham Barr <gbarr@pobox.com>. All rights reserved.
392This program is free software; you can redistribute it and/or
393modify it under the same terms as Perl itself.
394
395=cut
396