diff options
author | Gurusamy Sarathy <gsar@cpan.org> | 2000-04-24 08:50:13 +0000 |
---|---|---|
committer | Gurusamy Sarathy <gsar@cpan.org> | 2000-04-24 08:50:13 +0000 |
commit | 334f17bde01003b370737ba39ab0a63542aca6dc (patch) | |
tree | 534729e04d61d2e8df5589ffe0b615aeb2dd9def /ext/IO | |
parent | 855383171f82b0033b4163a01d30ba375967a9d0 (diff) | |
download | perl-334f17bde01003b370737ba39ab0a63542aca6dc.tar.gz |
revert change#5923 ("breaks" t/lib/io_poll.t)
p4raw-link: @5923 on //depot/perl: 8bcaa1dfb69612366728f7905b96ca3f11eafd21
p4raw-id: //depot/perl@5928
Diffstat (limited to 'ext/IO')
-rw-r--r-- | ext/IO/lib/IO/Poll.pm | 70 |
1 files changed, 39 insertions, 31 deletions
diff --git a/ext/IO/lib/IO/Poll.pm b/ext/IO/lib/IO/Poll.pm index fb1c58ea29..687664b9ab 100644 --- a/ext/IO/lib/IO/Poll.pm +++ b/ext/IO/lib/IO/Poll.pm @@ -1,4 +1,3 @@ - # IO::Poll.pm # # Copyright (c) 1997-8 Graham Barr <gbarr@pobox.com>. All rights reserved. @@ -13,31 +12,28 @@ use Exporter (); our(@ISA, @EXPORT_OK, @EXPORT, $VERSION); @ISA = qw(Exporter); -$VERSION = "0.04"; +$VERSION = "0.01"; -@EXPORT = qw( POLLIN - POLLOUT - POLLERR - POLLHUP - POLLNVAL - ); +@EXPORT = qw(poll); @EXPORT_OK = qw( + POLLIN POLLPRI + POLLOUT POLLRDNORM POLLWRNORM POLLRDBAND POLLWRBAND POLLNORM + POLLERR + POLLHUP + POLLNVAL ); -# [0] maps fd's to requested masks -# [1] maps fd's to returned masks -# [2] maps fd's to handles sub new { my $class = shift; - my $self = bless [{},{},{}], $class; + my $self = bless [{},{}], $class; $self; } @@ -48,19 +44,18 @@ sub mask { my $fd = fileno($io); if(@_) { my $mask = shift; + $self->[0]{$fd} ||= {}; if($mask) { - $self->[0]{$fd} = $mask; - $self->[1]{$fd} = 0; # no returned mask until poll() called - $self->[2]{$fd} = $io; - } else { - delete $self->[0]{$fd}; - delete $self->[1]{$fd}; - delete $self->[2]{$fd}; + $self->[0]{$fd}{$io} = $mask; + } + else { + delete $self->[0]{$fd}{$io}; } } - - return unless exists $self->[1]{$fd}; - return $self->[1]{$fd}; + elsif(exists $self->[0]{$fd}{$io}) { + return $self->[0]{$fd}{$io}; + } + return; } @@ -69,11 +64,13 @@ sub poll { $self->[1] = {}; - my($fd,$mask); + my($fd,$ref); my @poll = (); - while(($fd,$mask) = each %{$self->[0]}) { - push(@poll,$fd => $mask); + while(($fd,$ref) = each %{$self->[0]}) { + my $events = 0; + map { $events |= $_ } values %{$ref}; + push(@poll,$fd, $events); } my $ret = @poll ? _poll(defined($timeout) ? $timeout * 1000 : -1,@poll) : 0; @@ -83,7 +80,8 @@ sub poll { while(@poll) { my($fd,$got) = splice(@poll,0,2); - $self->[1]{$fd} = $got if $got; + $self->[1]{$fd} = $got + if $got; } return $ret; @@ -93,7 +91,10 @@ sub events { my $self = shift; my $io = shift; my $fd = fileno($io); - exists $self->[1]{$fd} ? $self->[1]{$fd} : 0; + + exists $self->[1]{$fd} && exists $self->[0]{$fd}{$io} + ? $self->[1]{$fd} & $self->[0]{$fd}{$io} + : 0; } sub remove { @@ -104,14 +105,21 @@ sub remove { sub handles { my $self = shift; - return values %{$self->[2]} unless @_; + + return map { keys %$_ } values %{$self->[0]} + unless(@_); my $events = shift || 0; my($fd,$ev,$io,$mask); my @handles = (); while(($fd,$ev) = each %{$self->[1]}) { - push @handles,$self->[2]{$fd} if $ev & $events; + if($ev & $events) { + while(($io,$mask) = each %{$self->[0][$fd]}) { + push(@handles, $io) + if $events & $mask; + } + } } return @handles; } @@ -130,8 +138,8 @@ IO::Poll - Object interface to system poll call $poll = new IO::Poll; - $poll->mask($input_handle => POLLIN); - $poll->mask($output_handle => POLLOUT); + $poll->mask($input_handle => POLLRDNORM | POLLIN | POLLHUP); + $poll->mask($output_handle => POLLWRNORM); $poll->poll($timeout); |