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