File Coverage

blib/lib/MHFS/EventLoop/Poll/Linux/Timer.pm
Criterion Covered Total %
statement 26 60 43.3
branch 0 14 0.0
condition n/a
subroutine 9 13 69.2
pod n/a
total 35 87 40.2


line stmt bran cond sub pod time code
1             package MHFS::EventLoop::Poll::Linux::Timer v0.7.0;
2 1     1   20 use 5.014;
  1         4  
3 1     1   6 use strict; use warnings;
  1     1   2  
  1         42  
  1         6  
  1         2  
  1         63  
4 1     1   6 use IO::Poll qw(POLLIN POLLOUT POLLHUP);
  1         2  
  1         68  
5 1     1   5 use POSIX qw/floor/;
  1         3  
  1         46  
6 1     1   87 use Devel::Peek;
  1         2  
  1         5  
7 1     1   123 use feature 'say';
  1         2  
  1         161  
8 1     1   7 use Config;
  1         2  
  1         162  
9             if(index($Config{archname}, 'x86_64-linux') == -1) {
10             die("Unsupported arch: " . $Config{archname});
11             }
12             use constant {
13 1         1112 _clock_REALTIME => 0,
14             _clock_MONOTONIC => 1,
15             _clock_BOOTTIME => 7,
16             _clock_REALTIME_ALARM => 8,
17             _clock_BOOTTIME_ALARM => 9,
18              
19             _ENOTTY => 25, #constant for Linux?
20 1     1   6 };
  1         2  
21             # x86_64 numbers
22             require 'syscall.ph';
23              
24             my $TFD_CLOEXEC = 0x80000;
25             my $TFD_NONBLOCK = 0x800;
26              
27             sub new {
28 0     0     my ($class, $evp) = @_;
29 0           my $timerfd = syscall(SYS_timerfd_create(), _clock_MONOTONIC, $TFD_NONBLOCK | $TFD_CLOEXEC);
30 0 0         $timerfd != -1 or die("failed to create timerfd: $!");
31 0           my $timerhandle = IO::Handle->new_from_fd($timerfd, "r");
32 0 0         $timerhandle or die("failed to turn timerfd into a file handle");
33 0           my %self = ('timerfd' => $timerfd, 'timerhandle' => $timerhandle);
34 0           bless \%self, $class;
35              
36 0           $evp->set($self{'timerhandle'}, \%self, POLLIN);
37 0           $self{'evp'} = $evp;
38 0           return \%self;
39             }
40              
41             sub packitimerspec {
42 0     0     my ($times) = @_;
43 0           my $it_interval_sec = int($times->{'it_interval'});
44 0           my $it_interval_nsec = floor(($times->{'it_interval'} - $it_interval_sec) * 1000000000);
45 0           my $it_value_sec = int($times->{'it_value'});
46 0           my $it_value_nsec = floor(($times->{'it_value'} - $it_value_sec) * 1000000000);
47             #say "packing $it_interval_sec, $it_interval_nsec, $it_value_sec, $it_value_nsec";
48 0           return pack 'qqqq', $it_interval_sec, $it_interval_nsec, $it_value_sec, $it_value_nsec;
49             }
50              
51             sub settime_linux {
52 0     0     my ($self, $start, $interval) = @_;
53             # assume start 0 is supposed to run immediately not try to cancel a timer
54 0 0         $start = ($start > 0.000000001) ? $start : 0.000000001;
55 0           my $new_value = packitimerspec({'it_interval' => $interval, 'it_value' => $start});
56 0           my $settime_success = syscall(SYS_timerfd_settime(), $self->{'timerfd'}, 0, $new_value,0);
57 0 0         ($settime_success == 0) or die("timerfd_settime failed: $!");
58             }
59              
60             sub onReadReady {
61 0     0     my ($self) = @_;
62 0           my $nread;
63             my $buf;
64 0           while($nread = sysread($self->{'timerhandle'}, $buf, 8)) {
65 0 0         if($nread < 8) {
66 0           say "timer hit, ignoring $nread bytes";
67 0           next;
68             }
69 0           my $expirations = unpack 'Q', $buf;
70 0           say "Linux::Timer there were $expirations expirations";
71             }
72 0 0         if(! defined $nread) {
73 0 0         if( ! $!{EAGAIN}) {
74 0           say "sysread failed with $!";
75             }
76              
77             }
78 0           $self->{'evp'}->check_timers;
79 0           return 1;
80             };
81             1;