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 select system 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 creates 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 E<lt>F<Graham.Barr@tiuk.ti.com>E<gt>
 122
 123 =head1 REVISION
 124
 125 $Revision: 1.9 $
 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.9 $ =~ /(\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  my $r = $vec->[VEC_BITS];
 202
 203  defined($r) && (select($r,undef,undef,$timeout) > 0)
 204     ? _handles($vec, $r)
 205     : ();
 206 }
 207
 208 sub can_write
 209 {
 210  my $vec = shift;
 211  my $timeout = shift;
 212  my $w = $vec->[VEC_BITS];
 213
 214  defined($w) && (select(undef,$w,undef,$timeout) > 0)
 215     ? _handles($vec, $w)
 216     : ();
 217 }
 218
 219 sub has_error
 220 {
 221  my $vec = shift;
 222  my $timeout = shift;
 223  my $e = $vec->[VEC_BITS];
 224
 225  defined($e) && (select(undef,undef,$e,$timeout) > 0)
 226     ? _handles($vec, $e)
 227     : ();
 228 }
 229
 230 sub count
 231 {
 232  my $vec = shift;
 233  $vec->[FD_COUNT];
 234 }
 235
 236 sub _max
 237 {
 238  my($a,$b,$c) = @_;
 239  $a > $b
 240     ? $a > $c
 241         ? $a
 242         : $c
 243     : $b > $c
 244         ? $b
 245         : $c;
 246 }
 247
 248 sub select
 249 {
 250  shift
 251    if defined $_[0] && !ref($_[0]);
 252
 253  my($r,$w,$e,$t) = @_;
 254  my @result = ();
 255
 256  my $rb = defined $r ? $r->[VEC_BITS] : undef;
 257  my $wb = defined $w ? $e->[VEC_BITS] : undef;
 258  my $eb = defined $e ? $w->[VEC_BITS] : undef;
 259
 260  if(select($rb,$wb,$eb,$t) > 0)
 261   {
 262    my @r = ();
 263    my @w = ();
 264    my @e = ();
 265    my $i = _max(defined $r ? scalar(@$r)-1 : 0,
 266                 defined $w ? scalar(@$w)-1 : 0,
 267                 defined $e ? scalar(@$e)-1 : 0);
 268
 269    for( ; $i >= FIRST_FD ; $i--)
 270     {
 271      my $j = $i - FIRST_FD;
 272      push(@r, $r->[$i])
 273         if defined $rb && defined $r->[$i] && vec($rb, $j, 1);
 274      push(@w, $w->[$i])
 275         if defined $wb && defined $w->[$i] && vec($wb, $j, 1);
 276      push(@e, $e->[$i])
 277         if defined $eb && defined $e->[$i] && vec($eb, $j, 1);
 278     }
 279
 280    @result = (\@r, \@w, \@e);
 281   }
 282  @result;
 283 }
 284
 285 sub _handles
 286 {
 287  my $vec = shift;
 288  my $bits = shift;
 289  my @h = ();
 290  my $i;
 291
 292  for($i = scalar(@$vec) - 1 ; $i >= FIRST_FD ; $i--)
 293   {
 294    next unless defined $vec->[$i];
 295    push(@h, $vec->[$i])
 296       if vec($bits,$i - FIRST_FD,1);
 297   }
 298
 299  @h;
 300 }
 301
 302 1;