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