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