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