[Summary view] [Print] [Text view]

   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     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 deprecated 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)->can_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 exception 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 an 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, EXCEPTION [, TIMEOUT ] )
 328  
 329  C<select> is a static method, that is you call it with the package name
 330  like C<new>. C<READ>, C<WRITE> and C<EXCEPTION> are either C<undef> or
 331  C<IO::Select> objects. C<TIMEOUT> is optional and has the same effect as
 332  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  exceptions respectively. Upon error an empty list 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