ext/IO/lib/IO/Poll.pm

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