summaryrefslogtreecommitdiff
path: root/beagle/debian-rfs/usr/lib/perl/5.10.1/IO/Select.pm
diff options
context:
space:
mode:
authorManuel Traut <manut@mecka.net>2011-04-29 09:09:27 +0200
committerManuel Traut <manut@mecka.net>2011-04-29 09:09:27 +0200
commit5238ad5a0c4a9e1c8cd036f5de4055e39bd71297 (patch)
tree4407c087b9fb5432b1dc11e70b52dacfa0b99feb /beagle/debian-rfs/usr/lib/perl/5.10.1/IO/Select.pm
parent60ead65c41afba7e6aa4bbcf507a1d52f7a8fe9f (diff)
added debootstrap stuff
Signed-off-by: Manuel Traut <manut@mecka.net>
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.pm233
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__
+