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::Countdown; |
7
|
|
|
|
|
|
|
|
8
|
11
|
|
|
11
|
|
91669
|
use strict; |
|
11
|
|
|
|
|
20
|
|
|
11
|
|
|
|
|
328
|
|
9
|
11
|
|
|
11
|
|
55
|
use warnings; |
|
11
|
|
|
|
|
24
|
|
|
11
|
|
|
|
|
413
|
|
10
|
11
|
|
|
11
|
|
176
|
use base qw( IO::Async::Timer ); |
|
11
|
|
|
|
|
86
|
|
|
11
|
|
|
|
|
5366
|
|
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
our $VERSION = '0.801'; |
13
|
|
|
|
|
|
|
|
14
|
11
|
|
|
11
|
|
120
|
use Carp; |
|
11
|
|
|
|
|
22
|
|
|
11
|
|
|
|
|
5318
|
|
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
=head1 NAME |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
C - event callback after a fixed delay |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
=head1 SYNOPSIS |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
use IO::Async::Timer::Countdown; |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
use IO::Async::Loop; |
25
|
|
|
|
|
|
|
my $loop = IO::Async::Loop->new; |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
my $timer = IO::Async::Timer::Countdown->new( |
28
|
|
|
|
|
|
|
delay => 10, |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
on_expire => sub { |
31
|
|
|
|
|
|
|
print "Sorry, your time's up\n"; |
32
|
|
|
|
|
|
|
$loop->stop; |
33
|
|
|
|
|
|
|
}, |
34
|
|
|
|
|
|
|
); |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
$timer->start; |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
$loop->add( $timer ); |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
$loop->run; |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
=head1 DESCRIPTION |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
This subclass of L implements one-shot fixed delays. |
45
|
|
|
|
|
|
|
The object implements a countdown timer, which invokes its callback after the |
46
|
|
|
|
|
|
|
given period from when it was started. After it has expired the Timer may be |
47
|
|
|
|
|
|
|
started again, when it will wait the same period then invoke the callback |
48
|
|
|
|
|
|
|
again. A timer that is currently running may be stopped or reset. |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
For a C object that repeatedly runs a callback at regular intervals, |
51
|
|
|
|
|
|
|
see instead L. For a C that invokes its |
52
|
|
|
|
|
|
|
callback at a fixed time in the future, see L. |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
=cut |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
=head1 EVENTS |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
The following events are invoked, either using subclass methods or CODE |
59
|
|
|
|
|
|
|
references in parameters: |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
=head2 on_expire |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
Invoked when the timer expires. |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
=cut |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
=head1 PARAMETERS |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
The following named parameters may be passed to C or C: |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
=head2 on_expire => CODE |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
CODE reference for the C event. |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
=head2 delay => NUM |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
The delay in seconds after starting the timer until it expires. Cannot be |
78
|
|
|
|
|
|
|
changed if the timer is running. A timer with a zero delay expires |
79
|
|
|
|
|
|
|
"immediately". |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
=head2 remove_on_expire => BOOL |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
Optional. If true, remove this timer object from its parent notifier or |
84
|
|
|
|
|
|
|
containing loop when it expires. Defaults to false. |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
Once constructed, the timer object will need to be added to the C before |
87
|
|
|
|
|
|
|
it will work. It will also need to be started by the C method. |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
=cut |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
sub configure |
92
|
|
|
|
|
|
|
{ |
93
|
17
|
|
|
17
|
1
|
3239
|
my $self = shift; |
94
|
17
|
|
|
|
|
64
|
my %params = @_; |
95
|
|
|
|
|
|
|
|
96
|
17
|
|
|
|
|
54
|
foreach (qw( remove_on_expire )) { |
97
|
17
|
100
|
|
|
|
82
|
$self->{$_} = delete $params{$_} if exists $params{$_}; |
98
|
|
|
|
|
|
|
} |
99
|
|
|
|
|
|
|
|
100
|
17
|
100
|
|
|
|
69
|
if( exists $params{on_expire} ) { |
101
|
14
|
|
|
|
|
42
|
my $on_expire = delete $params{on_expire}; |
102
|
14
|
50
|
|
|
|
81
|
ref $on_expire or croak "Expected 'on_expire' as a reference"; |
103
|
|
|
|
|
|
|
|
104
|
14
|
|
|
|
|
68
|
$self->{on_expire} = $on_expire; |
105
|
14
|
|
|
|
|
70
|
undef $self->{cb}; # Will be lazily constructed when needed |
106
|
|
|
|
|
|
|
} |
107
|
|
|
|
|
|
|
|
108
|
17
|
100
|
|
|
|
68
|
if( exists $params{delay} ) { |
109
|
16
|
100
|
|
|
|
143
|
$self->is_running and croak "Cannot configure 'delay' of a running timer\n"; |
110
|
|
|
|
|
|
|
|
111
|
15
|
|
|
|
|
45
|
my $delay = delete $params{delay}; |
112
|
15
|
50
|
|
|
|
63
|
$delay >= 0 or croak "Expected a 'delay' as a non-negative number"; |
113
|
|
|
|
|
|
|
|
114
|
15
|
|
|
|
|
51
|
$self->{delay} = $delay; |
115
|
|
|
|
|
|
|
} |
116
|
|
|
|
|
|
|
|
117
|
16
|
50
|
|
|
|
103
|
unless( $self->can_event( 'on_expire' ) ) { |
118
|
0
|
|
|
|
|
0
|
croak 'Expected either a on_expire callback or an ->on_expire method'; |
119
|
|
|
|
|
|
|
} |
120
|
|
|
|
|
|
|
|
121
|
16
|
|
|
|
|
128
|
$self->SUPER::configure( %params ); |
122
|
|
|
|
|
|
|
} |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
=head1 METHODS |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
=cut |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
=head2 is_expired |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
$expired = $timer->is_expired |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
Returns true if the Timer has already expired. |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
=cut |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
sub is_expired |
137
|
|
|
|
|
|
|
{ |
138
|
14
|
|
|
14
|
1
|
91
|
my $self = shift; |
139
|
14
|
|
|
|
|
116
|
return $self->{expired}; |
140
|
|
|
|
|
|
|
} |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
sub _make_cb |
143
|
|
|
|
|
|
|
{ |
144
|
10
|
|
|
10
|
|
29
|
my $self = shift; |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
return $self->_capture_weakself( sub { |
147
|
9
|
50
|
|
9
|
|
64
|
my $self = shift or return; |
148
|
|
|
|
|
|
|
|
149
|
9
|
|
|
|
|
44
|
undef $self->{id}; |
150
|
9
|
|
|
|
|
35
|
$self->{expired} = 1; |
151
|
|
|
|
|
|
|
|
152
|
9
|
100
|
|
|
|
62
|
$self->remove_from_parent if $self->{remove_on_expire}; |
153
|
|
|
|
|
|
|
|
154
|
9
|
|
|
|
|
149
|
$self->invoke_event( "on_expire" ); |
155
|
10
|
|
|
|
|
153
|
} ); |
156
|
|
|
|
|
|
|
} |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
sub _make_enqueueargs |
159
|
|
|
|
|
|
|
{ |
160
|
29
|
|
|
29
|
|
65
|
my $self = shift; |
161
|
|
|
|
|
|
|
|
162
|
29
|
|
|
|
|
68
|
undef $self->{expired}; |
163
|
29
|
|
|
|
|
188
|
return after => $self->{delay}; |
164
|
|
|
|
|
|
|
} |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
=head2 reset |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
$timer->reset |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
If the timer is running, restart the countdown period from now. If the timer |
171
|
|
|
|
|
|
|
is not running, this method has no effect. |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
=cut |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
sub reset |
176
|
|
|
|
|
|
|
{ |
177
|
1
|
|
|
1
|
1
|
3
|
my $self = shift; |
178
|
|
|
|
|
|
|
|
179
|
1
|
50
|
|
|
|
10
|
my $loop = $self->loop or croak "Cannot reset a Timer that is not in a Loop"; |
180
|
|
|
|
|
|
|
|
181
|
1
|
50
|
|
|
|
8
|
return if !$self->is_running; |
182
|
|
|
|
|
|
|
|
183
|
1
|
|
|
|
|
7
|
$self->stop; |
184
|
1
|
|
|
|
|
6
|
$self->start; |
185
|
|
|
|
|
|
|
} |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
=head1 EXAMPLES |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
=head2 Watchdog Timer |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
Because the C method restarts a running countdown timer back to its |
192
|
|
|
|
|
|
|
full period, it can be used to implement a watchdog timer. This is a timer |
193
|
|
|
|
|
|
|
which will not expire provided the method is called at least as often as it |
194
|
|
|
|
|
|
|
is configured. If the method fails to be called, the timer will eventually |
195
|
|
|
|
|
|
|
expire and run its callback. |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
For example, to expire an accepted connection after 30 seconds of inactivity: |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
... |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
on_accept => sub { |
202
|
|
|
|
|
|
|
my ( $newclient ) = @_; |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
my $watchdog = IO::Async::Timer::Countdown->new( |
205
|
|
|
|
|
|
|
delay => 30, |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
on_expire => sub { |
208
|
|
|
|
|
|
|
my $self = shift; |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
my $stream = $self->parent; |
211
|
|
|
|
|
|
|
$stream->close; |
212
|
|
|
|
|
|
|
}, |
213
|
|
|
|
|
|
|
); |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
my $stream = IO::Async::Stream->new( |
216
|
|
|
|
|
|
|
handle => $newclient, |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
on_read => sub { |
219
|
|
|
|
|
|
|
my ( $self, $buffref, $eof ) = @_; |
220
|
|
|
|
|
|
|
$watchdog->reset; |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
... |
223
|
|
|
|
|
|
|
}, |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
on_closed => sub { |
226
|
|
|
|
|
|
|
$watchdog->stop; |
227
|
|
|
|
|
|
|
}, |
228
|
|
|
|
|
|
|
) ); |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
$stream->add_child( $watchdog ); |
231
|
|
|
|
|
|
|
$watchdog->start; |
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
$loop->add( $watchdog ); |
234
|
|
|
|
|
|
|
} |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
Rather than setting up a lexical variable to store the Stream so that the |
237
|
|
|
|
|
|
|
Timer's C closure can call C on it, the parent/child |
238
|
|
|
|
|
|
|
relationship between the two Notifier objects is used. At the time the Timer |
239
|
|
|
|
|
|
|
C closure is invoked, it will have been added as a child notifier |
240
|
|
|
|
|
|
|
of the Stream; this means the Timer's C method will return the Stream |
241
|
|
|
|
|
|
|
Notifier. This enables it to call C without needing to capture a |
242
|
|
|
|
|
|
|
lexical variable, which would create a cyclic reference. |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
=head2 Fixed-Delay Repeating Timer |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
The C event fires a fixed delay after the C method has begun |
247
|
|
|
|
|
|
|
the countdown. The C method can be invoked again at some point during |
248
|
|
|
|
|
|
|
the C handling code, to create a timer that invokes its code |
249
|
|
|
|
|
|
|
regularly a fixed delay after the previous invocation has finished. This |
250
|
|
|
|
|
|
|
creates an arrangement similar to an L, except |
251
|
|
|
|
|
|
|
that it will wait until the previous invocation has indicated it is finished, |
252
|
|
|
|
|
|
|
before starting the countdown for the next call. |
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
my $timer = IO::Async::Timer::Countdown->new( |
255
|
|
|
|
|
|
|
delay => 60, |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
on_expire => sub { |
258
|
|
|
|
|
|
|
my $self = shift; |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
start_some_operation( |
261
|
|
|
|
|
|
|
on_complete => sub { $self->start }, |
262
|
|
|
|
|
|
|
); |
263
|
|
|
|
|
|
|
}, |
264
|
|
|
|
|
|
|
); |
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
$timer->start; |
267
|
|
|
|
|
|
|
$loop->add( $timer ); |
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
This example invokes the C function 60 seconds after the |
270
|
|
|
|
|
|
|
previous iteration has indicated it has finished. |
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
=head1 AUTHOR |
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
Paul Evans |
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
=cut |
277
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
0x55AA; |