File Coverage

blib/lib/IO/Async/Timer/Absolute.pm
Criterion Covered Total %
statement 33 34 97.0
branch 10 14 71.4
condition n/a
subroutine 8 8 100.0
pod 1 1 100.0
total 52 57 91.2


line stmt bran cond sub pod time code
1             # You may distribute under the terms of either the GNU General Public License
2             # or the Artistic License (the same terms as Perl itself)
3             #
4             # (C) Paul Evans, 2010-2015 -- leonerd@leonerd.org.uk
5              
6             package IO::Async::Timer::Absolute;
7              
8 2     2   94046 use strict;
  2         5  
  2         62  
9 2     2   16 use warnings;
  2         5  
  2         55  
10 2     2   11 use base qw( IO::Async::Timer );
  2         4  
  2         611  
11              
12             our $VERSION = '0.801';
13              
14 2     2   14 use Carp;
  2         5  
  2         677  
15              
16             =head1 NAME
17              
18             C - event callback at a fixed future time
19              
20             =head1 SYNOPSIS
21              
22             use IO::Async::Timer::Absolute;
23              
24             use POSIX qw( mktime );
25              
26             use IO::Async::Loop;
27             my $loop = IO::Async::Loop->new;
28              
29             my @time = gmtime;
30              
31             my $timer = IO::Async::Timer::Absolute->new(
32             time => mktime( 0, 0, 0, $time[3]+1, $time[4], $time[5] ),
33              
34             on_expire => sub {
35             print "It's midnight\n";
36             $loop->stop;
37             },
38             );
39              
40             $loop->add( $timer );
41              
42             $loop->run;
43              
44             =head1 DESCRIPTION
45              
46             This subclass of L implements one-shot events at a fixed
47             time in the future. The object waits for a given timestamp, and invokes its
48             callback at that point in the future.
49              
50             For a C object that waits for a delay relative to the time it is
51             started, see instead L.
52              
53             =cut
54              
55             =head1 EVENTS
56              
57             The following events are invoked, either using subclass methods or CODE
58             references in parameters:
59              
60             =head2 on_expire
61              
62             Invoked when the timer expires.
63              
64             =cut
65              
66             =head1 PARAMETERS
67              
68             The following named parameters may be passed to C or C:
69              
70             =head2 on_expire => CODE
71              
72             CODE reference for the C event.
73              
74             =head2 time => NUM
75              
76             The epoch time at which the timer will expire.
77              
78             Once constructed, the timer object will need to be added to the C before
79             it will work.
80              
81             Unlike other timers, it does not make sense to C this object, because
82             its expiry time is absolute, and not relative to the time it is started.
83              
84             =cut
85              
86             sub configure
87             {
88 7     7 1 24 my $self = shift;
89 7         22 my %params = @_;
90              
91 7 100       24 if( exists $params{on_expire} ) {
92 5         14 my $on_expire = delete $params{on_expire};
93 5 50       14 ref $on_expire or croak "Expected 'on_expire' as a reference";
94              
95 5         19 $self->{on_expire} = $on_expire;
96 5         16 undef $self->{cb}; # Will be lazily constructed when needed
97             }
98              
99 7 100       24 if( exists $params{time} ) {
100 6         17 my $time = delete $params{time};
101              
102 6 100       23 $self->stop if $self->is_running;
103              
104 6         19 $self->{time} = $time;
105              
106 6 50       16 $self->start if !$self->is_running;
107             }
108              
109 7 50       27 unless( $self->can_event( 'on_expire' ) ) {
110 0         0 croak 'Expected either a on_expire callback or an ->on_expire method';
111             }
112              
113 7         30 $self->SUPER::configure( %params );
114             }
115              
116             sub _make_cb
117             {
118 5     5   8 my $self = shift;
119              
120             return $self->_capture_weakself( sub {
121 4 50   4   20 my $self = shift or return;
122              
123 4         14 undef $self->{id};
124              
125 4         60 $self->invoke_event( "on_expire" );
126 5         46 } );
127             }
128              
129             sub _make_enqueueargs
130             {
131 6     6   11 my $self = shift;
132              
133 6         34 return at => $self->{time};
134             }
135              
136             =head1 AUTHOR
137              
138             Paul Evans
139              
140             =cut
141              
142             0x55AA;