IO::Select - OO interface to the select system call


IO documentation Contained in the IO distribution.

Index


Code Index:

NAME

Top

IO::Select - OO interface to the select system call

SYNOPSIS

Top

    use IO::Select;

    $s = IO::Select->new();

    $s->add(\*STDIN);
    $s->add($some_handle);

    @ready = $s->can_read($timeout);

    @ready = IO::Select->new(@handles)->can_read(0);

DESCRIPTION

Top

The IO::Select package implements an object approach to the system select function call. It allows the user to see what IO handles, see IO::Handle, are ready for reading, writing or have an exception pending.

CONSTRUCTOR

Top

new ( [ HANDLES ] )

The constructor creates a new object and optionally initialises it with a set of handles.

METHODS

Top

add ( HANDLES )

Add the list of handles to the IO::Select object. It is these values that will be returned when an event occurs. IO::Select keeps these values in a cache which is indexed by the fileno of the handle, so if more than one handle with the same fileno is specified then only the last one is cached.

Each handle can be an IO::Handle object, an integer or an array reference where the first element is an IO::Handle or an integer.

remove ( HANDLES )

Remove all the given handles from the object. This method also works by the fileno of the handles. So the exact handles that were added need not be passed, just handles that have an equivalent fileno

exists ( HANDLE )

Returns a true value (actually the handle itself) if it is present. Returns undef otherwise.

handles

Return an array of all registered handles.

can_read ( [ TIMEOUT ] )

Return an array of handles that are ready for reading. TIMEOUT is the maximum amount of time to wait before returning an empty list, in seconds, possibly fractional. If TIMEOUT is not given and any handles are registered then the call will block.

can_write ( [ TIMEOUT ] )

Same as can_read except check for handles that can be written to.

has_exception ( [ TIMEOUT ] )

Same as can_read except check for handles that have an exception condition, for example pending out-of-band data.

count ()

Returns the number of handles that the object will check for when one of the can_ methods is called or the object is passed to the select static method.

bits()

Return the bit string suitable as argument to the core select() call.

select ( READ, WRITE, EXCEPTION [, TIMEOUT ] )

select is a static method, that is you call it with the package name like new. READ, WRITE and EXCEPTION are either undef or IO::Select objects. TIMEOUT is optional and has the same effect as for the core select call.

The result will be an array of 3 elements, each a reference to an array which will hold the handles that are ready for reading, writing and have exceptions respectively. Upon error an empty list is returned.

EXAMPLE

Top

Here is a short example which shows how IO::Select could be used to write a server which communicates with several sockets while also listening for more connections on a listen socket

    use IO::Select;
    use IO::Socket;

    $lsn = new IO::Socket::INET(Listen => 1, LocalPort => 8080);
    $sel = new IO::Select( $lsn );

    while(@ready = $sel->can_read) {
        foreach $fh (@ready) {
            if($fh == $lsn) {
                # Create a new socket
                $new = $lsn->accept;
                $sel->add($new);
            }
            else {
                # Process socket

                # Maybe we have finished with the socket
                $sel->remove($fh);
                $fh->close;
            }
        }
    }

AUTHOR

Top

Graham Barr. Currently maintained by the Perl Porters. Please report all bugs to <perl5-porters@perl.org>.

COPYRIGHT

Top


IO documentation Contained in the IO distribution.

# IO::Select.pm
#
# Copyright (c) 1997-8 Graham Barr <gbarr@pobox.com>. All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.

package IO::Select;

use     strict;
use warnings::register;
use     vars qw($VERSION @ISA);
require Exporter;

$VERSION = "1.17";

@ISA = qw(Exporter); # This is only so we can do version checking

sub VEC_BITS () {0}
sub FD_COUNT () {1}
sub FIRST_FD () {2}

sub new
{
 my $self = shift;
 my $type = ref($self) || $self;

 my $vec = bless [undef,0], $type;

 $vec->add(@_)
    if @_;

 $vec;
}

sub add
{
 shift->_update('add', @_);
}


sub remove
{
 shift->_update('remove', @_);
}


sub exists
{
 my $vec = shift;
 my $fno = $vec->_fileno(shift);
 return undef unless defined $fno;
 $vec->[$fno + FIRST_FD];
}


sub _fileno
{
 my($self, $f) = @_;
 return unless defined $f;
 $f = $f->[0] if ref($f) eq 'ARRAY';
 ($f =~ /^\d+$/) ? $f : fileno($f);
}

sub _update
{
 my $vec = shift;
 my $add = shift eq 'add';

 my $bits = $vec->[VEC_BITS];
 $bits = '' unless defined $bits;

 my $count = 0;
 my $f;
 foreach $f (@_)
  {
   my $fn = $vec->_fileno($f);
   next unless defined $fn;
   my $i = $fn + FIRST_FD;
   if ($add) {
     if (defined $vec->[$i]) {
	 $vec->[$i] = $f;  # if array rest might be different, so we update
	 next;
     }
     $vec->[FD_COUNT]++;
     vec($bits, $fn, 1) = 1;
     $vec->[$i] = $f;
   } else {      # remove
     next unless defined $vec->[$i];
     $vec->[FD_COUNT]--;
     vec($bits, $fn, 1) = 0;
     $vec->[$i] = undef;
   }
   $count++;
  }
 $vec->[VEC_BITS] = $vec->[FD_COUNT] ? $bits : undef;
 $count;
}

sub can_read
{
 my $vec = shift;
 my $timeout = shift;
 my $r = $vec->[VEC_BITS];

 defined($r) && (select($r,undef,undef,$timeout) > 0)
    ? handles($vec, $r)
    : ();
}

sub can_write
{
 my $vec = shift;
 my $timeout = shift;
 my $w = $vec->[VEC_BITS];

 defined($w) && (select(undef,$w,undef,$timeout) > 0)
    ? handles($vec, $w)
    : ();
}

sub has_exception
{
 my $vec = shift;
 my $timeout = shift;
 my $e = $vec->[VEC_BITS];

 defined($e) && (select(undef,undef,$e,$timeout) > 0)
    ? handles($vec, $e)
    : ();
}

sub has_error
{
 warnings::warn("Call to deprecated method 'has_error', use 'has_exception'")
	if warnings::enabled();
 goto &has_exception;
}

sub count
{
 my $vec = shift;
 $vec->[FD_COUNT];
}

sub bits
{
 my $vec = shift;
 $vec->[VEC_BITS];
}

sub as_string  # for debugging
{
 my $vec = shift;
 my $str = ref($vec) . ": ";
 my $bits = $vec->bits;
 my $count = $vec->count;
 $str .= defined($bits) ? unpack("b*", $bits) : "undef";
 $str .= " $count";
 my @handles = @$vec;
 splice(@handles, 0, FIRST_FD);
 for (@handles) {
     $str .= " " . (defined($_) ? "$_" : "-");
 }
 $str;
}

sub _max
{
 my($a,$b,$c) = @_;
 $a > $b
    ? $a > $c
        ? $a
        : $c
    : $b > $c
        ? $b
        : $c;
}

sub select
{
 shift
   if defined $_[0] && !ref($_[0]);

 my($r,$w,$e,$t) = @_;
 my @result = ();

 my $rb = defined $r ? $r->[VEC_BITS] : undef;
 my $wb = defined $w ? $w->[VEC_BITS] : undef;
 my $eb = defined $e ? $e->[VEC_BITS] : undef;

 if(select($rb,$wb,$eb,$t) > 0)
  {
   my @r = ();
   my @w = ();
   my @e = ();
   my $i = _max(defined $r ? scalar(@$r)-1 : 0,
                defined $w ? scalar(@$w)-1 : 0,
                defined $e ? scalar(@$e)-1 : 0);

   for( ; $i >= FIRST_FD ; $i--)
    {
     my $j = $i - FIRST_FD;
     push(@r, $r->[$i])
        if defined $rb && defined $r->[$i] && vec($rb, $j, 1);
     push(@w, $w->[$i])
        if defined $wb && defined $w->[$i] && vec($wb, $j, 1);
     push(@e, $e->[$i])
        if defined $eb && defined $e->[$i] && vec($eb, $j, 1);
    }

   @result = (\@r, \@w, \@e);
  }
 @result;
}


sub handles
{
 my $vec = shift;
 my $bits = shift;
 my @h = ();
 my $i;
 my $max = scalar(@$vec) - 1;

 for ($i = FIRST_FD; $i <= $max; $i++)
  {
   next unless defined $vec->[$i];
   push(@h, $vec->[$i])
      if !defined($bits) || vec($bits, $i - FIRST_FD, 1);
  }
 
 @h;
}

1;
__END__