… | |
… | |
11 | This package implements a simple timer callback system which works |
11 | This package implements a simple timer callback system which works |
12 | independent of the event loop mechanism used. If no event mechanism is |
12 | independent of the event loop mechanism used. If no event mechanism is |
13 | used, it is emulated. The C<Coro::Event> module overwrites functions with |
13 | used, it is emulated. The C<Coro::Event> module overwrites functions with |
14 | versions better suited. |
14 | versions better suited. |
15 | |
15 | |
|
|
16 | This module is not subclassable. |
|
|
17 | |
16 | =over 4 |
18 | =over 4 |
17 | |
19 | |
18 | =cut |
20 | =cut |
19 | |
21 | |
20 | package Coro::Timer; |
22 | package Coro::Timer; |
21 | |
23 | |
22 | no warnings qw(uninitialized); |
24 | no warnings qw(uninitialized); |
23 | |
25 | |
24 | use Carp (); |
26 | use Carp (); |
|
|
27 | use Exporter; |
25 | |
28 | |
26 | use Coro (); |
29 | use Coro (); |
27 | |
30 | |
|
|
31 | BEGIN { |
28 | BEGIN { eval "use Time::HiRes 'time'" } |
32 | eval "use Time::HiRes 'time'"; |
|
|
33 | } |
29 | |
34 | |
30 | $VERSION = 0.52; |
35 | $VERSION = 0.52; |
|
|
36 | @EXPORT_OK = qw(timeout sleep); |
31 | |
37 | |
32 | =item $flag = Coro::Timer::timeout $seconds; |
38 | =item $flag = timeout $seconds; |
33 | |
39 | |
34 | This function will wake up the current coroutine after $seconds |
40 | This function will wake up the current coroutine after $seconds |
35 | seconds and sets $flag to true (it is false intiially). If $flag goes |
41 | seconds and sets $flag to true (it is false intiially). If $flag goes |
36 | out of scope earlier nothing happens. This is used to implement the |
42 | out of scope earlier nothing happens. This is used to implement the |
37 | C<timed_down>, C<timed_wait> etc. primitives. |
43 | C<timed_down>, C<timed_wait> etc. primitives. It is used like this: |
|
|
44 | |
|
|
45 | sub timed_wait { |
|
|
46 | my $timeout = Coro::Timer::timeout 60; |
|
|
47 | |
|
|
48 | while (condition false) { |
|
|
49 | schedule; # wait until woken up or timeout |
|
|
50 | return 0 if $timeout; # timed out |
|
|
51 | } |
|
|
52 | return 1; # condition satisfied |
|
|
53 | } |
38 | |
54 | |
39 | =cut |
55 | =cut |
40 | |
56 | |
41 | # deep magic, expecially the double indirection :(:( |
57 | # deep magic, expecially the double indirection :(:( |
42 | sub timeout($) { |
58 | sub timeout($) { |
43 | my $self = \\my $timer; |
59 | my $self = \\my $timer; |
44 | my $current = $Coro::current; |
60 | my $current = $Coro::current; |
45 | $timer = _new_timer(Coro::Timer, time + $_[0], sub { |
61 | $timer = _new_timer(time + $_[0], sub { |
46 | undef $timer; # set flag |
62 | undef $timer; # set flag |
47 | $current->ready; |
63 | $current->ready; |
48 | }); |
64 | }); |
49 | bless $self, Coro::timeout::; |
65 | bless $self, Coro::timeout::; |
50 | } |
66 | } |
… | |
… | |
56 | |
72 | |
57 | use overload 'bool' => \&bool, '0+' => \&bool; |
73 | use overload 'bool' => \&bool, '0+' => \&bool; |
58 | |
74 | |
59 | package Coro::Timer; |
75 | package Coro::Timer; |
60 | |
76 | |
|
|
77 | =item sleep $seconds |
|
|
78 | |
|
|
79 | This function works like the built-in sleep, except maybe more precise |
|
|
80 | and, most important, without blocking other coroutines. |
|
|
81 | |
|
|
82 | =cut |
|
|
83 | |
|
|
84 | sub sleep { |
|
|
85 | my $current = $Coro::current; |
|
|
86 | _new_timer(time + $_[0], sub { $current->ready }); |
|
|
87 | Coro::schedule; |
|
|
88 | } |
|
|
89 | |
61 | =item $timer = new Coro::Timer at/after => xxx, cb => \&yyy; |
90 | =item $timer = new Coro::Timer at/after => xxx, cb => \&yyy; |
62 | |
91 | |
63 | Create a new timer. |
92 | Create a new timer. |
64 | |
93 | |
65 | =cut |
94 | =cut |
… | |
… | |
68 | my $class = shift; |
97 | my $class = shift; |
69 | my %arg = @_; |
98 | my %arg = @_; |
70 | |
99 | |
71 | $arg{at} = time + delete $arg{after} if exists $arg{after}; |
100 | $arg{at} = time + delete $arg{after} if exists $arg{after}; |
72 | |
101 | |
73 | _new_timer($class, $arg{at}, $arg{cb}); |
102 | _new_timer($arg{at}, $arg{cb}); |
74 | } |
103 | } |
75 | |
104 | |
76 | my $timer; |
105 | my $timer; |
77 | my @timer; |
106 | my @timer; |
78 | |
107 | |
79 | unless ($override) { |
108 | unless ($override) { |
80 | $override = 1; |
109 | $override = 1; |
81 | *_new_timer = sub { |
110 | *_new_timer = sub { |
82 | my $self = bless [$_[1], $_[2]], $_[0]; |
111 | my $self = bless [$_[0], $_[1]], Coro::Timer::simple; |
83 | |
112 | |
84 | # my version of rapid prototyping. guys, use a real event module! |
113 | # my version of rapid prototyping. guys, use a real event module! |
85 | @timer = sort { $a->[0] cmp $b->[0] } @timer, $self; |
114 | @timer = sort { $a->[0] cmp $b->[0] } @timer, $self; |
86 | |
115 | |
87 | unless ($timer) { |
116 | unless ($timer) { |
… | |
… | |
104 | } |
133 | } |
105 | |
134 | |
106 | $self; |
135 | $self; |
107 | }; |
136 | }; |
108 | |
137 | |
109 | *cancel = sub { |
138 | *Coro::Timer::simple::cancel = sub { |
110 | @{$_[0]} = (); |
139 | @{$_[0]} = (); |
111 | }; |
140 | }; |
112 | } |
141 | } |
113 | |
142 | |
114 | =item $timer->cancel |
143 | =item $timer->cancel |