File Coverage

blib/lib/IO/Poll.pm
Criterion Covered Total %
statement 55 65 84.6
branch 17 24 70.8
condition 3 5 60.0
subroutine 9 9 100.0
pod 5 6 83.3
total 89 109 81.6


line stmt bran cond sub pod time code
1              
2             # IO::Poll.pm
3             #
4             # Copyright (c) 1997-8 Graham Barr . All rights reserved.
5             # This program is free software; you can redistribute it and/or
6             # modify it under the same terms as Perl itself.
7              
8             package IO::Poll;
9              
10 2     2   56290 use strict;
  2         10  
  2         51  
11 2     2   414 use IO::Handle;
  2         3  
  2         62  
12 2     2   9 use Exporter ();
  2         9  
  2         1172  
13              
14             our @ISA = qw(Exporter);
15             our $VERSION = "1.49";
16              
17             our @EXPORT = qw( POLLIN
18             POLLOUT
19             POLLERR
20             POLLHUP
21             POLLNVAL
22             );
23              
24             our @EXPORT_OK = qw(
25             POLLPRI
26             POLLRDNORM
27             POLLWRNORM
28             POLLRDBAND
29             POLLWRBAND
30             POLLNORM
31             );
32              
33             # [0] maps fd's to requested masks
34             # [1] maps fd's to returned masks
35             # [2] maps fd's to handles
36             sub new {
37 2     2 0 107 my $class = shift;
38              
39 2         10 my $self = bless [{},{},{}], $class;
40              
41 2         5 $self;
42             }
43              
44             sub mask {
45 9     9 1 58 my $self = shift;
46 9         9 my $io = shift;
47 9         14 my $fd = fileno($io);
48 9 50       16 return unless defined $fd;
49 9 100       15 if (@_) {
50 6         7 my $mask = shift;
51 6 100       9 if($mask) {
52 3         12 $self->[0]{$fd}{$io} = $mask; # the error events are always returned
53 3         4 $self->[1]{$fd} = 0; # output mask
54 3         6 $self->[2]{$io} = $io; # remember handle
55             } else {
56 3         9 delete $self->[0]{$fd}{$io};
57 3 100       3 unless(%{$self->[0]{$fd}}) {
  3         6  
58             # We no longer have any handles for this FD
59 2         5 delete $self->[1]{$fd};
60 2         3 delete $self->[0]{$fd};
61             }
62 3         8 delete $self->[2]{$io};
63             }
64             }
65            
66 9 100 100     47 return unless exists $self->[0]{$fd} and exists $self->[0]{$fd}{$io};
67 5         11 return $self->[0]{$fd}{$io};
68             }
69              
70              
71             sub poll {
72 4     4 1 40 my($self,$timeout) = @_;
73              
74 4         9 $self->[1] = {};
75              
76 4         7 my($fd,$mask,$iom);
77 4         5 my @poll = ();
78              
79 4         14 while(($fd,$iom) = each %{$self->[0]}) {
  6         21  
80 2         3 $mask = 0;
81 2         7 $mask |= $_ for values(%$iom);
82 2         3 push(@poll,$fd => $mask);
83             }
84              
85 4 50       2202471 my $ret = _poll(defined($timeout) ? $timeout * 1000 : -1,@poll);
86              
87 4 100       53 return $ret
88             unless $ret > 0;
89              
90 1         2 while(@poll) {
91 1         3 my($fd,$got) = splice(@poll,0,2);
92 1 50       12 $self->[1]{$fd} = $got if $got;
93             }
94              
95 1         20 return $ret;
96             }
97              
98             sub events {
99 3     3 1 27 my $self = shift;
100 3         4 my $io = shift;
101 3         6 my $fd = fileno($io);
102             exists $self->[1]{$fd} and exists $self->[0]{$fd}{$io}
103 3 50       23 ? $self->[1]{$fd} & ($self->[0]{$fd}{$io}|POLLHUP|POLLERR|POLLNVAL)
    100          
104             : 0;
105             }
106              
107             sub remove {
108 3     3 1 59 my $self = shift;
109 3         4 my $io = shift;
110 3         8 $self->mask($io,0);
111             }
112              
113             sub handles {
114 3     3 1 17 my $self = shift;
115 3 50       5 return values %{$self->[2]} unless @_;
  3         11  
116              
117 0   0       my $events = shift || 0;
118 0           my($fd,$ev,$io,$mask);
119 0           my @handles = ();
120              
121 0           while(($fd,$ev) = each %{$self->[1]}) {
  0            
122 0           while (($io,$mask) = each %{$self->[0]{$fd}}) {
  0            
123 0           $mask |= POLLHUP|POLLERR|POLLNVAL; # must allow these
124 0 0         push @handles,$self->[2]{$io} if ($ev & $mask) & $events;
125             }
126             }
127 0           return @handles;
128             }
129              
130             1;
131              
132             __END__