lib/PublicInbox/DSPoll.pm

   1 # Copyright (C) 2019-2020 all contributors <meta@public-inbox.org>
   2 # Licensed the same as Danga::Socket (and Perl5)
   3 # License: GPL-1.0+ or Artistic-1.0-Perl
   4 #  <https://www.gnu.org/licenses/gpl-1.0.txt>
   5 #  <https://dev.perl.org/licenses/artistic.html>
   6 #
   7 # poll(2) via IO::Poll core module.  This makes poll look
   8 # like epoll to simplify the code in DS.pm.  This is NOT meant to be
   9 # an all encompassing emulation of epoll via IO::Poll, but just to
  10 # support cases public-inbox-nntpd/httpd care about.
  11 package PublicInbox::DSPoll;
  12 use strict;
  13 use warnings;
  14 use parent qw(Exporter);
  15 use IO::Poll;
  16 use PublicInbox::Syscall qw(EPOLLONESHOT EPOLLIN EPOLLOUT EPOLL_CTL_DEL);
  17 our @EXPORT_OK = qw(epoll_ctl epoll_wait);
  18
  19 sub new { bless {}, $_[0] } # fd => events
  20
  21 sub epoll_ctl {
  22         my ($self, $op, $fd, $ev) = @_;
  23
  24         # not wasting time on error checking
  25         if ($op != EPOLL_CTL_DEL) {
  26                 $self->{$fd} = $ev;
  27         } else {
  28                 delete $self->{$fd};
  29         }
  30         0;
  31 }
  32
  33 sub epoll_wait {
  34         my ($self, $maxevents, $timeout_msec, $events) = @_;
  35         my @pset;
  36         while (my ($fd, $events) = each %$self) {
  37                 my $pevents = $events & EPOLLIN ? POLLIN : 0;
  38                 $pevents |= $events & EPOLLOUT ? POLLOUT : 0;
  39                 push(@pset, $fd, $pevents);
  40         }
  41         @$events = ();
  42         my $n = IO::Poll::_poll($timeout_msec, @pset);
  43         if ($n >= 0) {
  44                 for (my $i = 0; $i < @pset; ) {
  45                         my $fd = $pset[$i++];
  46                         my $revents = $pset[$i++] or next;
  47                         delete($self->{$fd}) if $self->{$fd} & EPOLLONESHOT;
  48                         push @$events, [ $fd ];
  49                 }
  50                 my $nevents = scalar @$events;
  51                 if ($n != $nevents) {
  52                         warn "BUG? poll() returned $n, but got $nevents";
  53                 }
  54         }
  55         $n;
  56 }
  57
  58 1;