IO::Select: allow removal of IO::Handle objects without fileno
[perl.git] / dist / IO / lib / IO / Select.pm
1 # IO::Select.pm
2 #
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.
6
7 package IO::Select;
8
9 use     strict;
10 use warnings::register;
11 use     vars qw($VERSION @ISA);
12 require Exporter;
13
14 $VERSION = "1.17";
15
16 @ISA = qw(Exporter); # This is only so we can do version checking
17
18 sub VEC_BITS () {0}
19 sub FD_COUNT () {1}
20 sub FIRST_FD () {2}
21
22 sub new
23 {
24  my $self = shift;
25  my $type = ref($self) || $self;
26
27  my $vec = bless [undef,0], $type;
28
29  $vec->add(@_)
30     if @_;
31
32  $vec;
33 }
34
35 sub add
36 {
37  shift->_update('add', @_);
38 }
39
40
41 sub remove
42 {
43  shift->_update('remove', @_);
44 }
45
46
47 sub exists
48 {
49  my $vec = shift;
50  my $fno = $vec->_fileno(shift);
51  return undef unless defined $fno;
52  $vec->[$fno + FIRST_FD];
53 }
54
55
56 sub _fileno
57 {
58  my($self, $f) = @_;
59  return unless defined $f;
60  $f = $f->[0] if ref($f) eq 'ARRAY';
61  ($f =~ /^\d+$/) ? $f : fileno($f);
62 }
63
64 sub _update
65 {
66  my $vec = shift;
67  my $add = shift eq 'add';
68
69  my $bits = $vec->[VEC_BITS];
70  $bits = '' unless defined $bits;
71
72  my $count = 0;
73  my $f;
74  foreach $f (@_)
75   {
76    my $fn = $vec->_fileno($f);
77    if ($add) {
78      next unless defined $fn;
79      my $i = $fn + FIRST_FD;
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
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;
94      next unless defined $vec->[$i];
95      $vec->[FD_COUNT]--;
96      vec($bits, $fn, 1) = 0;
97      $vec->[$i] = undef;
98    }
99    $count++;
100   }
101  $vec->[VEC_BITS] = $vec->[FD_COUNT] ? $bits : undef;
102  $count;
103 }
104
105 sub can_read
106 {
107  my $vec = shift;
108  my $timeout = shift;
109  my $r = $vec->[VEC_BITS];
110
111  defined($r) && (select($r,undef,undef,$timeout) > 0)
112     ? handles($vec, $r)
113     : ();
114 }
115
116 sub can_write
117 {
118  my $vec = shift;
119  my $timeout = shift;
120  my $w = $vec->[VEC_BITS];
121
122  defined($w) && (select(undef,$w,undef,$timeout) > 0)
123     ? handles($vec, $w)
124     : ();
125 }
126
127 sub has_exception
128 {
129  my $vec = shift;
130  my $timeout = shift;
131  my $e = $vec->[VEC_BITS];
132
133  defined($e) && (select(undef,undef,$e,$timeout) > 0)
134     ? handles($vec, $e)
135     : ();
136 }
137
138 sub has_error
139 {
140  warnings::warn("Call to deprecated method 'has_error', use 'has_exception'")
141         if warnings::enabled();
142  goto &has_exception;
143 }
144
145 sub count
146 {
147  my $vec = shift;
148  $vec->[FD_COUNT];
149 }
150
151 sub bits
152 {
153  my $vec = shift;
154  $vec->[VEC_BITS];
155 }
156
157 sub 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
173 sub _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
185 sub select
186 {
187  shift
188    if defined $_[0] && !ref($_[0]);
189
190  my($r,$w,$e,$t) = @_;
191  my @result = ();
192
193  my $rb = defined $r ? $r->[VEC_BITS] : undef;
194  my $wb = defined $w ? $w->[VEC_BITS] : undef;
195  my $eb = defined $e ? $e->[VEC_BITS] : undef;
196
197  if(select($rb,$wb,$eb,$t) > 0)
198   {
199    my @r = ();
200    my @w = ();
201    my @e = ();
202    my $i = _max(defined $r ? scalar(@$r)-1 : 0,
203                 defined $w ? scalar(@$w)-1 : 0,
204                 defined $e ? scalar(@$e)-1 : 0);
205
206    for( ; $i >= FIRST_FD ; $i--)
207     {
208      my $j = $i - FIRST_FD;
209      push(@r, $r->[$i])
210         if defined $rb && defined $r->[$i] && vec($rb, $j, 1);
211      push(@w, $w->[$i])
212         if defined $wb && defined $w->[$i] && vec($wb, $j, 1);
213      push(@e, $e->[$i])
214         if defined $eb && defined $e->[$i] && vec($eb, $j, 1);
215     }
216
217    @result = (\@r, \@w, \@e);
218   }
219  @result;
220 }
221
222
223 sub handles
224 {
225  my $vec = shift;
226  my $bits = shift;
227  my @h = ();
228  my $i;
229  my $max = scalar(@$vec) - 1;
230
231  for ($i = FIRST_FD; $i <= $max; $i++)
232   {
233    next unless defined $vec->[$i];
234    push(@h, $vec->[$i])
235       if !defined($bits) || vec($bits, $i - FIRST_FD, 1);
236   }
237  
238  @h;
239 }
240
241 1;
242 __END__
243
244 =head1 NAME
245
246 IO::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
259     @ready = IO::Select->new(@handles)->can_read(0);
260
261 =head1 DESCRIPTION
262
263 The C<IO::Select> package implements an object approach to the system C<select>
264 function call. It allows the user to see what IO handles, see L<IO::Handle>,
265 are ready for reading, writing or have an exception pending.
266
267 =head1 CONSTRUCTOR
268
269 =over 4
270
271 =item new ( [ HANDLES ] )
272
273 The constructor creates a new object and optionally initialises it with a set
274 of handles.
275
276 =back
277
278 =head1 METHODS
279
280 =over 4
281
282 =item add ( HANDLES )
283
284 Add the list of handles to the C<IO::Select> object. It is these values that
285 will be returned when an event occurs. C<IO::Select> keeps these values in a
286 cache which is indexed by the C<fileno> of the handle, so if more than one
287 handle with the same C<fileno> is specified then only the last one is cached.
288
289 Each handle can be an C<IO::Handle> object, an integer or an array
290 reference where the first element is an C<IO::Handle> or an integer.
291
292 =item remove ( HANDLES )
293
294 Remove all the given handles from the object. This method also works
295 by the C<fileno> of the handles. So the exact handles that were added
296 need not be passed, just handles that have an equivalent C<fileno>
297
298 =item exists ( HANDLE )
299
300 Returns a true value (actually the handle itself) if it is present.
301 Returns undef otherwise.
302
303 =item handles
304
305 Return an array of all registered handles.
306
307 =item can_read ( [ TIMEOUT ] )
308
309 Return an array of handles that are ready for reading. C<TIMEOUT> is
310 the maximum amount of time to wait before returning an empty list, in
311 seconds, possibly fractional. If C<TIMEOUT> is not given and any
312 handles are registered then the call will block.
313
314 =item can_write ( [ TIMEOUT ] )
315
316 Same as C<can_read> except check for handles that can be written to.
317
318 =item has_exception ( [ TIMEOUT ] )
319
320 Same as C<can_read> except check for handles that have an exception
321 condition, for example pending out-of-band data.
322
323 =item count ()
324
325 Returns the number of handles that the object will check for when
326 one of the C<can_> methods is called or the object is passed to
327 the C<select> static method.
328
329 =item bits()
330
331 Return the bit string suitable as argument to the core select() call.
332
333 =item select ( READ, WRITE, EXCEPTION [, TIMEOUT ] )
334
335 C<select> is a static method, that is you call it with the package name
336 like C<new>. C<READ>, C<WRITE> and C<EXCEPTION> are either C<undef> or
337 C<IO::Select> objects. C<TIMEOUT> is optional and has the same effect as
338 for the core select call.
339
340 The result will be an array of 3 elements, each a reference to an array
341 which will hold the handles that are ready for reading, writing and have
342 exceptions respectively. Upon error an empty list is returned.
343
344 =back
345
346 =head1 EXAMPLE
347
348 Here is a short example which shows how C<IO::Select> could be used
349 to write a server which communicates with several sockets while also
350 listening 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 );
357
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
377 Graham Barr. Currently maintained by the Perl Porters.  Please report all
378 bugs to <perl5-porters@perl.org>.
379
380 =head1 COPYRIGHT
381
382 Copyright (c) 1997-8 Graham Barr <gbarr@pobox.com>. All rights reserved.
383 This program is free software; you can redistribute it and/or
384 modify it under the same terms as Perl itself.
385
386 =cut
387