File Coverage

blib/lib/IO/Async/Timer.pm
Criterion Covered Total %
statement 41 44 93.1
branch 14 20 70.0
condition n/a
subroutine 10 10 100.0
pod 4 4 100.0
total 69 78 88.4


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-2012 -- leonerd@leonerd.org.uk
5              
6             package IO::Async::Timer;
7              
8 15     15   1565 use strict;
  15         33  
  15         501  
9 15     15   139 use warnings;
  15         28  
  15         472  
10 15     15   78 use base qw( IO::Async::Notifier );
  15         27  
  15         3558  
11              
12             our $VERSION = '0.79';
13              
14 15     15   128 use Carp;
  15         26  
  15         7255  
15              
16             =head1 NAME
17              
18             C - base class for Notifiers that use timed delays
19              
20             =head1 DESCRIPTION
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 4687 my $class = shift;
74 34         161 my %args = @_;
75              
76 34 50       209 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         365 return $class->SUPER::new( %args );
85             }
86              
87             sub _add_to_loop
88             {
89 36     36   90 my $self = shift;
90 36 100       155 $self->start if delete $self->{pending};
91             }
92              
93             sub _remove_from_loop
94             {
95 30     30   72 my $self = shift;
96 30         130 $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 166     166 1 5971 my $self = shift;
115              
116 166         1230 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 2380 my $self = shift;
139              
140 110         308 my $loop = $self->loop;
141 110 100       331 if( !defined $loop ) {
142 31         76 $self->{pending} = 1;
143 31         85 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       244 if( !$self->{cb} ) {
149 30         181 $self->{cb} = $self->_make_cb;
150             }
151              
152             $self->{id} = $loop->watch_time(
153             $self->_make_enqueueargs,
154             code => $self->{cb},
155 79         338 );
156              
157 79         252 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 63     63 1 182 my $self = shift;
172              
173 63 100       242 if( $self->{pending} ) {
174 1         3 delete $self->{pending};
175 1         3 return;
176             }
177              
178 62 100       217 return if !$self->is_running;
179              
180 36 50       200 my $loop = $self->loop or croak "Cannot stop a Timer that is not in a Loop";
181              
182 36 50       122 defined $self->{id} or return; # nothing to do but no error
183              
184 36         179 $loop->unwatch_time( $self->{id} );
185              
186 36         1412 undef $self->{id};
187             }
188              
189             =head1 AUTHOR
190              
191             Paul Evans
192              
193             =cut
194              
195             0x55AA;