]> Sergey Matveev's repositories - public-inbox.git/blob - lib/PublicInbox/DSPoll.pm
imaptracker: preserve WAL journal_mode if set by user
[public-inbox.git] / 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;