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