File Coverage

blib/lib/IO/Async/Timer.pm
Criterion Covered Total %
statement 40 43 93.0
branch 14 20 70.0
condition n/a
subroutine 10 10 100.0
pod 4 4 100.0
total 68 77 88.3


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, 2009-2024 -- leonerd@leonerd.org.uk
5              
6             package IO::Async::Timer 0.805;
7              
8 15     15   1113 use v5.14;
  15         56  
9 15     15   75 use warnings;
  15         23  
  15         848  
10 15     15   82 use base qw( IO::Async::Notifier );
  15         44  
  15         4460  
11              
12 15     15   107 use Carp;
  15         24  
  15         7569  
13              
14             =head1 NAME
15              
16             C - base class for Notifiers that use timed delays
17              
18             =head1 DESCRIPTION
19              
20             =for highlighter language=perl
21              
22             This module provides a subclass of L for implementing
23             notifiers that use timed delays. For specific implementations, see one of the
24             subclasses:
25              
26             =over 8
27              
28             =item *
29              
30             L - event callback at a fixed future time
31              
32             =item *
33              
34             L - event callback after a fixed delay
35              
36             =item *
37              
38             L - event callback at regular intervals
39              
40             =back
41              
42             =cut
43              
44             =head1 CONSTRUCTOR
45              
46             =cut
47              
48             =head2 new
49              
50             $timer = IO::Async::Timer->new( %args );
51              
52             Constructs a particular subclass of C object, and returns
53             it. This constructor is provided for backward compatibility to older code
54             which doesn't use the subclasses. New code should directly construct a
55             subclass instead.
56              
57             =over 8
58              
59             =item mode => STRING
60              
61             The type of timer to create. Currently the only allowed mode is C
62             but more types may be added in the future.
63              
64             =back
65              
66             Once constructed, the C will need to be added to the C before it
67             will work. It will also need to be started by the C method.
68              
69             =cut
70              
71             sub new
72             {
73 34     34 1 4730 my $class = shift;
74 34         276 my %args = @_;
75              
76 34 50       186 if( my $mode = delete $args{mode} ) {
77             # Might define some other modes later
78 0 0       0 $mode eq "countdown" or croak "Expected 'mode' to be 'countdown'";
79              
80 0         0 require IO::Async::Timer::Countdown;
81 0         0 return IO::Async::Timer::Countdown->new( %args );
82             }
83              
84 34         338 return $class->SUPER::new( %args );
85             }
86              
87             sub _add_to_loop
88             {
89 36     36   111 my $self = shift;
90 36 100       201 $self->start if delete $self->{pending};
91             }
92              
93             sub _remove_from_loop
94             {
95 30     30   59 my $self = shift;
96 30         261 $self->stop;
97             }
98              
99             =head1 METHODS
100              
101             =cut
102              
103             =head2 is_running
104              
105             $running = $timer->is_running;
106              
107             Returns true if the Timer has been started, and has not yet expired, or been
108             stopped.
109              
110             =cut
111              
112             sub is_running
113             {
114 162     162 1 7822 my $self = shift;
115              
116 162         1537 defined $self->{id};
117             }
118              
119             =head2 start
120              
121             $timer->start;
122              
123             Starts the Timer. Throws an error if it was already running.
124              
125             If the Timer is not yet in a Loop, the actual start will be deferred until it
126             is added. Once added, it will be running, and will expire at the given
127             duration after the time it was added.
128              
129             As a convenience, C<$timer> is returned. This may be useful for starting
130             timers at construction time:
131              
132             $loop->add( IO::Async::Timer->new( ... )->start );
133              
134             =cut
135              
136             sub start
137             {
138 110     110 1 1648 my $self = shift;
139              
140 110         328 my $loop = $self->loop;
141 110 100       360 if( !defined $loop ) {
142 31         80 $self->{pending} = 1;
143 31         107 return $self;
144             }
145              
146 79 50       290 defined $self->{id} and croak "Cannot start a Timer that is already running";
147              
148 79 100       322 if( !$self->{cb} ) {
149 30         200 $self->{cb} = $self->_make_cb;
150             }
151              
152             $self->{id} = $loop->watch_time(
153             $self->_make_enqueueargs,
154             code => $self->{cb},
155 79         455 );
156              
157 79         932 return $self;
158             }
159              
160             =head2 stop
161              
162             $timer->stop;
163              
164             Stops the Timer if it is running. If it has not yet been added to the C
165             but there is a start pending, this will cancel it.
166              
167             =cut
168              
169             sub stop
170             {
171 61     61 1 269 my $self = shift;
172              
173 61 100       224 if( $self->{pending} ) {
174 1         3 delete $self->{pending};
175 1         5 return;
176             }
177              
178 60 100       244 return if !$self->is_running;
179              
180 34 50       112 my $loop = $self->loop or croak "Cannot stop a Timer that is not in a Loop";
181              
182 34 50       151 defined $self->{id} or return; # nothing to do but no error
183              
184 34         178 $loop->unwatch_time( $self->{id} );
185              
186 34         115 undef $self->{id};
187             }
188              
189             =head1 AUTHOR
190              
191             Paul Evans
192              
193             =cut
194              
195             0x55AA;