diff options
Diffstat (limited to 'beagle/debian-rfs/usr/lib/perl/5.10.1/IO/Select.pm')
| -rw-r--r-- | beagle/debian-rfs/usr/lib/perl/5.10.1/IO/Select.pm | 233 |
1 files changed, 233 insertions, 0 deletions
diff --git a/beagle/debian-rfs/usr/lib/perl/5.10.1/IO/Select.pm b/beagle/debian-rfs/usr/lib/perl/5.10.1/IO/Select.pm new file mode 100644 index 0000000..2a18c7d --- /dev/null +++ b/beagle/debian-rfs/usr/lib/perl/5.10.1/IO/Select.pm @@ -0,0 +1,233 @@ +# 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__ + |
