various bugs in IO::Poll (from Lincoln D. Stein <lstein@cshl.org>)

p4raw-id: //depot/perl@5923

diff --git a/ext/IO/lib/IO/Poll.pm b/ext/IO/lib/IO/Poll.pm
index 687664b..fb1c58e 100644 (file)
--- a/ext/IO/lib/IO/Poll.pm
+++ b/ext/IO/lib/IO/Poll.pm
@@ -1,3 +1,4 @@
+

 # IO::Poll.pm
 #
 # Copyright (c) 1997-8 Graham Barr <gbarr@pobox.com>. All rights reserved.
 # IO::Poll.pm
 #
 # Copyright (c) 1997-8 Graham Barr <gbarr@pobox.com>. All rights reserved.


@@ -12,28 +13,31 @@ use Exporter ();
 our(@ISA, @EXPORT_OK, @EXPORT, $VERSION);
 
 @ISA = qw(Exporter);
 our(@ISA, @EXPORT_OK, @EXPORT, $VERSION);
 
 @ISA = qw(Exporter);

-$VERSION = "0.01";
+$VERSION = "0.04";

 
 

-@EXPORT = qw(poll);
+@EXPORT = qw( POLLIN
+             POLLOUT
+             POLLERR
+             POLLHUP
+             POLLNVAL
+           );

 
 @EXPORT_OK = qw(
 
 @EXPORT_OK = qw(

- POLLIN    

  POLLPRI   
  POLLPRI   

- POLLOUT   

  POLLRDNORM
  POLLWRNORM
  POLLRDBAND
  POLLWRBAND
  POLLNORM  
  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;
 
 sub new {
     my $class = shift;
 

-    my $self = bless [{},{}], $class;
+    my $self = bless [{},{},{}], $class;

 
     $self;
 }
 
     $self;
 }


@@ -44,18 +48,19 @@ sub mask {
     my $fd = fileno($io);
     if(@_) {
        my $mask = shift;
     my $fd = fileno($io);
     if(@_) {
        my $mask = shift;

-       $self->[0]{$fd} ||= {};

        if($mask) {
        if($mask) {

-           $self->[0]{$fd}{$io} = $mask;
-       }
-       else {
-           delete $self->[0]{$fd}{$io};
+         $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};

        }
     }
        }
     }

-    elsif(exists $self->[0]{$fd}{$io}) {
-       return $self->[0]{$fd}{$io};
-    }
-    return;
+
+    return unless exists $self->[1]{$fd};
+    return $self->[1]{$fd};

 }
 
 
 }
 
 


@@ -64,13 +69,11 @@ sub poll {
 
     $self->[1] = {};
 
 
     $self->[1] = {};
 

-    my($fd,$ref);
+    my($fd,$mask);

     my @poll = ();
 
     my @poll = ();
 

-    while(($fd,$ref) = each %{$self->[0]}) {
-       my $events = 0;
-       map { $events |= $_ } values %{$ref};
-       push(@poll,$fd, $events);
+    while(($fd,$mask) = each %{$self->[0]}) {
+       push(@poll,$fd => $mask);

     }
 
     my $ret = @poll ? _poll(defined($timeout) ? $timeout * 1000 : -1,@poll) : 0;
     }
 
     my $ret = @poll ? _poll(defined($timeout) ? $timeout * 1000 : -1,@poll) : 0;


@@ -80,8 +83,7 @@ sub poll {
 
     while(@poll) {
        my($fd,$got) = splice(@poll,0,2);
 
     while(@poll) {
        my($fd,$got) = splice(@poll,0,2);

-       $self->[1]{$fd} = $got
-           if $got;
+       $self->[1]{$fd} = $got if $got;

     }
 
     return $ret;  
     }
 
     return $ret;  


@@ -91,10 +93,7 @@ sub events {
     my $self = shift;
     my $io = shift;
     my $fd = fileno($io);
     my $self = shift;
     my $io = shift;
     my $fd = fileno($io);

-
-    exists $self->[1]{$fd} && exists $self->[0]{$fd}{$io}
-       ? $self->[1]{$fd} & $self->[0]{$fd}{$io}
-       : 0;
+    exists $self->[1]{$fd} ? $self->[1]{$fd} : 0;

 }
 
 sub remove {
 }
 
 sub remove {


@@ -105,21 +104,14 @@ sub remove {
 
 sub handles {
     my $self = shift;
 
 sub handles {
     my $self = shift;

-
-    return map { keys %$_ } values %{$self->[0]}
-       unless(@_);
+    return values %{$self->[2]} unless @_;

 
     my $events = shift || 0;
     my($fd,$ev,$io,$mask);
     my @handles = ();
 
     while(($fd,$ev) = each %{$self->[1]}) {
 
     my $events = shift || 0;
     my($fd,$ev,$io,$mask);
     my @handles = ();
 
     while(($fd,$ev) = each %{$self->[1]}) {

-       if($ev & $events) {
-           while(($io,$mask) = each %{$self->[0][$fd]}) {
-               push(@handles, $io)
-                   if $events & $mask;
-           }
-       }
+      push @handles,$self->[2]{$fd} if $ev & $events;

     }
     return @handles;
 }
     }
     return @handles;
 }


@@ -138,8 +130,8 @@ IO::Poll - Object interface to system poll call
 
     $poll = new IO::Poll;
 
 
     $poll = new IO::Poll;
 

-    $poll->mask($input_handle => POLLRDNORM | POLLIN | POLLHUP);
-    $poll->mask($output_handle => POLLWRNORM);
+    $poll->mask($input_handle => POLLIN);
+    $poll->mask($output_handle => POLLOUT);

 
     $poll->poll($timeout);
 
 
     $poll->poll($timeout);