1 2# IO::Poll.pm 3# 4# Copyright (c) 1997-8 Graham Barr <gbarr@pobox.com>. 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 8package IO::Poll; 9 10use strict; 11use IO::Handle; 12use Exporter (); 13 14our @ISA = qw(Exporter); 15our $VERSION = "1.52"; 16 17our @EXPORT = qw( POLLIN 18 POLLOUT 19 POLLERR 20 POLLHUP 21 POLLNVAL 22 ); 23 24our @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 36sub new { 37 my $class = shift; 38 39 my $self = bless [{},{},{}], $class; 40 41 $self; 42} 43 44sub mask { 45 my $self = shift; 46 my $io = shift; 47 my $fd = fileno($io); 48 return unless defined $fd; 49 if (@_) { 50 my $mask = shift; 51 if($mask) { 52 $self->[0]{$fd}{$io} = $mask; # the error events are always returned 53 $self->[1]{$fd} = 0; # output mask 54 $self->[2]{$io} = $io; # remember handle 55 } else { 56 delete $self->[0]{$fd}{$io}; 57 unless(%{$self->[0]{$fd}}) { 58 # We no longer have any handles for this FD 59 delete $self->[1]{$fd}; 60 delete $self->[0]{$fd}; 61 } 62 delete $self->[2]{$io}; 63 } 64 } 65 66 return unless exists $self->[0]{$fd} and exists $self->[0]{$fd}{$io}; 67 return $self->[0]{$fd}{$io}; 68} 69 70 71sub poll { 72 my($self,$timeout) = @_; 73 74 $self->[1] = {}; 75 76 my($fd,$mask,$iom); 77 my @poll = (); 78 79 while(($fd,$iom) = each %{$self->[0]}) { 80 $mask = 0; 81 $mask |= $_ for values(%$iom); 82 push(@poll,$fd => $mask); 83 } 84 85 my $ret = _poll(defined($timeout) ? $timeout * 1000 : -1,@poll); 86 87 return $ret 88 unless $ret > 0; 89 90 while(@poll) { 91 my($fd,$got) = splice(@poll,0,2); 92 $self->[1]{$fd} = $got if $got; 93 } 94 95 return $ret; 96} 97 98sub events { 99 my $self = shift; 100 my $io = shift; 101 my $fd = fileno($io); 102 exists $self->[1]{$fd} and exists $self->[0]{$fd}{$io} 103 ? $self->[1]{$fd} & ($self->[0]{$fd}{$io}|POLLHUP|POLLERR|POLLNVAL) 104 : 0; 105} 106 107sub remove { 108 my $self = shift; 109 my $io = shift; 110 $self->mask($io,0); 111} 112 113sub handles { 114 my $self = shift; 115 return values %{$self->[2]} unless @_; 116 117 my $events = shift || 0; 118 my($fd,$ev,$io,$mask); 119 my @handles = (); 120 121 while(($fd,$ev) = each %{$self->[1]}) { 122 while (($io,$mask) = each %{$self->[0]{$fd}}) { 123 $mask |= POLLHUP|POLLERR|POLLNVAL; # must allow these 124 push @handles,$self->[2]{$io} if ($ev & $mask) & $events; 125 } 126 } 127 return @handles; 128} 129 1301; 131 132__END__ 133 134=head1 NAME 135 136IO::Poll - Object interface to system poll call 137 138=head1 SYNOPSIS 139 140 use IO::Poll qw(POLLRDNORM POLLWRNORM POLLIN POLLHUP); 141 142 $poll = IO::Poll->new(); 143 144 $poll->mask($input_handle => POLLIN); 145 $poll->mask($output_handle => POLLOUT); 146 147 $poll->poll($timeout); 148 149 $ev = $poll->events($input); 150 151=head1 DESCRIPTION 152 153C<IO::Poll> is a simple interface to the system level poll routine. 154 155=head1 METHODS 156 157=over 4 158 159=item mask ( IO [, EVENT_MASK ] ) 160 161If EVENT_MASK is given, then, if EVENT_MASK is non-zero, IO is added to the 162list of file descriptors and the next call to poll will check for 163any event specified in EVENT_MASK. If EVENT_MASK is zero then IO will be 164removed from the list of file descriptors. 165 166If EVENT_MASK is not given then the return value will be the current 167event mask value for IO. 168 169=item poll ( [ TIMEOUT ] ) 170 171Call the system level poll routine. If TIMEOUT is not specified then the 172call will block. Returns the number of handles which had events 173happen, or -1 on error. 174 175=item events ( IO ) 176 177Returns the event mask which represents the events that happened on IO 178during the last call to C<poll>. 179 180=item remove ( IO ) 181 182Remove IO from the list of file descriptors for the next poll. 183 184=item handles( [ EVENT_MASK ] ) 185 186Returns a list of handles. If EVENT_MASK is not given then a list of all 187handles known will be returned. If EVENT_MASK is given then a list 188of handles will be returned which had one of the events specified by 189EVENT_MASK happen during the last call ti C<poll> 190 191=back 192 193=head1 SEE ALSO 194 195L<poll(2)>, L<IO::Handle>, L<IO::Select> 196 197=head1 AUTHOR 198 199Graham Barr. Currently maintained by the Perl Porters. Please report all 200bugs at L<https://github.com/Perl/perl5/issues>. 201 202=head1 COPYRIGHT 203 204Copyright (c) 1997-8 Graham Barr <gbarr@pobox.com>. All rights reserved. 205This program is free software; you can redistribute it and/or 206modify it under the same terms as Perl itself. 207 208=cut 209