ext/IO/lib/IO/Select.pm

   1 # IO::Select.pm
   2
   3 package IO::Select;
   4
   5 =head1 NAME
   6
   7 IO::Select - OO interface to the system select call
   8
   9 =head1 SYNOPSIS
  10
  11     use IO::Select;
  12
  13     $s = IO::Select->new();
  14
  15     $s->add(\*STDIN);
  16     $s->add($some_handle);
  17
  18     @ready = $s->can_read($timeout);
  19
  20     @ready = IO::Select->new(@handles)->read(0);
  21
  22 =head1 DESCRIPTION
  23
  24 The C<IO::Select> package implements an object approach to the system C<select>
  25 function call. It allows the user to see what IO handles, see L<IO::Handle>,
  26 are ready for reading, writing or have an error condition pending.
  27
  28 =head1 CONSTRUCTOR
  29
  30 =over 4
  31
  32 =item new ( [ HANDLES ] )
  33
  34 The constructor create a new object and optionally initialises it with a set
  35 of handles.
  36
  37 =back
  38
  39 =head1 METHODS
  40
  41 =over 4
  42
  43 =item add ( HANDLES )
  44
  45 Add the list of handles to the C<IO::Select> object. It is these values that
  46 will be returned when an event occurs. C<IO::Select> keeps these values in a
  47 cache which is indexed by the C<fileno> of the handle, so if more than one
  48 handle with the same C<fileno> is specified then only the last one is cached.
  49
  50 =item remove ( HANDLES )
  51
  52 Remove all the given handles from the object. This method also works
  53 by the C<fileno> of the handles. So the exact handles that were added
  54 need not be passed, just handles that have an equivalent C<fileno>
  55
  56 =item can_read ( [ TIMEOUT ] )
  57
  58 Return an array of handles that are ready for reading. C<TIMEOUT> is the maximum
  59 amount of time to wait before returning an empty list. If C<TIMEOUT> is
  60 not given then the call will block.
  61
  62 =item can_write ( [ TIMEOUT ] )
  63
  64 Same as C<can_read> except check for handles that can be written to.
  65
  66 =item has_error ( [ TIMEOUT ] )
  67
  68 Same as C<can_read> except check for handles that have an error condition, for
  69 example EOF.
  70
  71 =item count ()
  72
  73 Returns the number of handles that the object will check for when
  74 one of the C<can_> methods is called or the object is passed to
  75 the C<select> static method.
  76
  77 =item select ( READ, WRITE, ERROR [, TIMEOUT ] )
  78
  79 C<select> is a static method, that is you call it with the package name
  80 like C<new>. C<READ>, C<WRITE> and C<ERROR> are either C<undef> or
  81 C<IO::Select> objects. C<TIMEOUT> is optional and has the same effect as
  82 before.
  83
  84 The result will be an array of 3 elements, each a reference to an array
  85 which will hold the handles that are ready for reading, writing and have
  86 error conditions respectively. Upon error an empty array is returned.
  87
  88 =back
  89
  90 =head1 EXAMPLE
  91
  92 Here is a short example which shows how C<IO::Select> could be used
  93 to write a server which communicates with several sockets while also
  94 listening for more connections on a listen socket
  95
  96     use IO::Select;
  97     use IO::Socket;
  98
  99     $lsn = new IO::Socket::INET(Listen => 1, LocalPort => 8080);
 100     $sel = new IO::Select( $lsn );
 101
 102     while(@ready = $sel->can_read) {
 103         foreach $fh (@ready) {
 104             if($fh == $lsn) {
 105                 # Create a new socket
 106                 $new = $lsn->accept;
 107                 $sel->add($new);
 108             }
 109             else {
 110                 # Process socket
 111
 112                 # Maybe we have finished with the socket
 113                 $sel->remove($fh);
 114                 $fh->close;
 115             }
 116         }
 117     }
 118
 119 =head1 AUTHOR
 120
 121 Graham Barr <Graham.Barr@tiuk.ti.com>
 122
 123 =head1 REVISION
 124
 125 $Revision: 1.2 $
 126
 127 =head1 COPYRIGHT
 128
 129 Copyright (c) 1995 Graham Barr. All rights reserved. This program is free
 130 software; you can redistribute it and/or modify it under the same terms
 131 as Perl itself.
 132
 133 =cut
 134
 135 use     strict;
 136 use     vars qw($VERSION @ISA);
 137 require Exporter;
 138
 139 $VERSION = sprintf("%d.%02d", q$Revision: 1.2 $ =~ /(\d+)\.(\d+)/);
 140
 141 @ISA = qw(Exporter); # This is only so we can do version checking
 142
 143 sub VEC_BITS {0}
 144 sub FD_COUNT {1}
 145 sub FIRST_FD {2}
 146
 147 sub new
 148 {
 149  my $self = shift;
 150  my $type = ref($self) || $self;
 151
 152  my $vec = bless [undef,0], $type;
 153
 154  $vec->add(@_)
 155     if @_;
 156
 157  $vec;
 158 }
 159
 160 sub add
 161 {
 162  my $vec = shift;
 163  my $f;
 164
 165  $vec->[VEC_BITS] = '' unless defined $vec->[VEC_BITS];
 166
 167  foreach $f (@_)
 168   {
 169    my $fn = $f =~ /^\d+$/ ? $f : fileno($f);
 170    next
 171     unless defined $fn;
 172    vec($vec->[VEC_BITS],$fn,1) = 1;
 173    $vec->[FD_COUNT] += 1
 174         unless defined $vec->[$fn+FIRST_FD];
 175    $vec->[$fn+FIRST_FD] = $f;
 176   }
 177  $vec->[VEC_BITS] = undef unless $vec->count;
 178 }
 179
 180 sub remove
 181 {
 182  my $vec = shift;
 183  my $f;
 184
 185  foreach $f (@_)
 186   {
 187    my $fn = $f =~ /^\d+$/ ? $f : fileno($f);
 188    next
 189     unless defined $fn;
 190    vec($vec->[VEC_BITS],$fn,1) = 0;
 191    $vec->[$fn+FIRST_FD] = undef;
 192    $vec->[FD_COUNT] -= 1;
 193   }
 194  $vec->[VEC_BITS] = undef unless $vec->count;
 195 }
 196
 197 sub can_read
 198 {
 199  my $vec = shift;
 200  my $timeout = shift;
 201
 202  my $r = $vec->[VEC_BITS] or return ();
 203
 204  select($r,undef,undef,$timeout) > 0
 205     ? _handles($vec, $r)
 206     : ();
 207 }
 208
 209 sub can_write
 210 {
 211  my $vec = shift;
 212  my $timeout = shift;
 213
 214  my $w = $vec->[VEC_BITS] or return ();
 215
 216  select(undef,$w,undef,$timeout) > 0
 217     ? _handles($vec, $w)
 218     : ();
 219 }
 220
 221 sub has_error
 222 {
 223  my $vec = shift;
 224  my $timeout = shift;
 225
 226  my $e = $vec->[VEC_BITS] or return ();
 227
 228  select(undef,undef,$e,$timeout) > 0
 229     ? _handles($vec, $e)
 230     : ();
 231 }
 232
 233 sub count
 234 {
 235  my $vec = shift;
 236  $vec->[FD_COUNT];
 237 }
 238
 239 sub _max
 240 {
 241  my($a,$b,$c) = @_;
 242  $a > $b
 243     ? $a > $c
 244         ? $a
 245         : $c
 246     : $b > $c
 247         ? $b
 248         : $c;
 249 }
 250
 251 sub select
 252 {
 253  shift
 254    if defined $_[0] && !ref($_[0]);
 255
 256  my($r,$w,$e,$t) = @_;
 257  my @result = ();
 258
 259  my $rb = defined $r ? $r->[VEC_BITS] : undef;
 260  my $wb = defined $w ? $e->[VEC_BITS] : undef;
 261  my $eb = defined $e ? $w->[VEC_BITS] : undef;
 262
 263  if(select($rb,$wb,$eb,$t) > 0)
 264   {
 265    my @r = ();
 266    my @w = ();
 267    my @e = ();
 268    my $i = _max(defined $r ? scalar(@$r)-1 : 0,
 269                 defined $w ? scalar(@$w)-1 : 0,
 270                 defined $e ? scalar(@$e)-1 : 0);
 271
 272    for( ; $i >= FIRST_FD ; $i--)
 273     {
 274      my $j = $i - FIRST_FD;
 275      push(@r, $r->[$i])
 276         if defined $rb && defined $r->[$i] && vec($rb, $j, 1);
 277      push(@w, $w->[$i])
 278         if defined $wb && defined $w->[$i] && vec($wb, $j, 1);
 279      push(@e, $e->[$i])
 280         if defined $eb && defined $e->[$i] && vec($eb, $j, 1);
 281     }
 282
 283    @result = (\@r, \@w, \@e);
 284   }
 285  @result;
 286 }
 287
 288 sub _handles
 289 {
 290  my $vec = shift;
 291  my $bits = shift;
 292  my @h = ();
 293  my $i;
 294
 295  for($i = scalar(@$vec) - 1 ; $i >= FIRST_FD ; $i--)
 296   {
 297    next unless defined $vec->[$i];
 298    push(@h, $vec->[$i])
 299       if vec($bits,$i - FIRST_FD,1);
 300   }
 301
 302  @h;
 303 }
 304
 305 1;
 306