| 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; |