<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;"># IO::Select.pm
#
# Copyright (c) 1997-8 Graham Barr &lt;gbarr@pobox.com&gt;. 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.20";

@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-&gt;add(@_)
    if @_;

 $vec;
}

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

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

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

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

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

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

 my $count = 0;
 my $f;
 foreach $f (@_)
  {
   my $fn = $vec-&gt;_fileno($f);
   if ($add) {
     next unless defined $fn;
     my $i = $fn + FIRST_FD;
     if (defined $vec-&gt;[$i]) {
	 $vec-&gt;[$i] = $f;  # if array rest might be different, so we update
	 next;
     }
     $vec-&gt;[FD_COUNT]++;
     vec($bits, $fn, 1) = 1;
     $vec-&gt;[$i] = $f;
   } else {      # remove
     if ( ! defined $fn ) { # remove if fileno undef'd
         defined($_) &amp;&amp; $_ == $f and do { $vec-&gt;[FD_COUNT]--; $_ = undef; }
           for @{$vec}[FIRST_FD .. $#$vec];
         next;
     }
     my $i = $fn + FIRST_FD;
     next unless defined $vec-&gt;[$i];
     $vec-&gt;[FD_COUNT]--;
     vec($bits, $fn, 1) = 0;
     $vec-&gt;[$i] = undef;
   }
   $count++;
  }
 $vec-&gt;[VEC_BITS] = $vec-&gt;[FD_COUNT] ? $bits : undef;
 $count;
}

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

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

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

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

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

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

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

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

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

sub as_string  # for debugging
{
 my $vec = shift;
 my $str = ref($vec) . ": ";
 my $bits = $vec-&gt;bits;
 my $count = $vec-&gt;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 &gt; $b
    ? $a &gt; $c
        ? $a
        : $c
    : $b &gt; $c
        ? $b
        : $c;
}

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

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

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

 if(select($rb,$wb,$eb,$t) &gt; 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 &gt;= FIRST_FD ; $i--)
    {
     my $j = $i - FIRST_FD;
     push(@r, $r-&gt;[$i])
        if defined $rb &amp;&amp; defined $r-&gt;[$i] &amp;&amp; vec($rb, $j, 1);
     push(@w, $w-&gt;[$i])
        if defined $wb &amp;&amp; defined $w-&gt;[$i] &amp;&amp; vec($wb, $j, 1);
     push(@e, $e-&gt;[$i])
        if defined $eb &amp;&amp; defined $e-&gt;[$i] &amp;&amp; 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 &lt;= $max; $i++)
  {
   next unless defined $vec-&gt;[$i];
   push(@h, $vec-&gt;[$i])
      if !defined($bits) || vec($bits, $i - FIRST_FD, 1);
  }
 
 @h;
}

1;
__END__

</pre></body></html>