ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Coro/Coro/Timer.pm
(Generate patch)

Comparing Coro/Coro/Timer.pm (file contents):
Revision 1.10 by root, Sat Mar 22 23:08:40 2003 UTC vs.
Revision 1.57 by root, Thu Nov 20 14:57:45 2008 UTC

… …
10 sleep 10; 10 sleep 10;
11 11
12=head1 DESCRIPTION 12=head1 DESCRIPTION
13 13
14This package implements a simple timer callback system which works 14This package implements a simple timer callback system which works
15independent of the event loop mechanism used. If no event mechanism is 15independent of the event loop mechanism used.
16used, it is emulated. The C<Coro::Event> module overwrites functions with
17versions better suited.
18
19This module is not subclassable.
20 16
21=over 4 17=over 4
22 18
23=cut 19=cut
24 20
25package Coro::Timer; 21package Coro::Timer;
26 22
27no warnings qw(uninitialized); 23no warnings;
28 24
29use Carp (); 25use Carp ();
30use Exporter; 26use Exporter;
31 27
28use AnyEvent ();
29
32use Coro (); 30use Coro ();
31use Coro::AnyEvent ();
33 32
34BEGIN {
35 eval "use Time::HiRes 'time'";
36}
37
38$VERSION = 0.65; 33$VERSION = "5.0";
39@EXPORT_OK = qw(timeout sleep); 34@EXPORT_OK = qw(timeout sleep);
40 35
41=item $flag = timeout $seconds; 36=item $flag = timeout $seconds;
42 37
43This function will wake up the current coroutine after $seconds 38This function will wake up the current coroutine after $seconds
44seconds and sets $flag to true (it is false intiially). If $flag goes 39seconds and sets $flag to true (it is false initially). If $flag goes
45out of scope earlier nothing happens. This is used to implement the 40out of scope earlier nothing happens. This is used to implement the
46C<timed_down>, C<timed_wait> etc. primitives. It is used like this: 41C<timed_down>, C<timed_wait> etc. primitives. It is used like this:
47 42
48 sub timed_wait { 43 sub timed_wait {
49 my $timeout = Coro::Timer::timeout 60; 44 my $timeout = Coro::Timer::timeout 60;
50 45
51 while (condition false) { 46 while (condition false) {
52 schedule; # wait until woken up or timeout 47 Coro::schedule; # wait until woken up or timeout
53 return 0 if $timeout; # timed out 48 return 0 if $timeout; # timed out
54 } 49 }
50
55 return 1; # condition satisfied 51 return 1; # condition satisfied
56 } 52 }
57 53
58=cut 54=cut
59 55
60# deep magic, expecially the double indirection :(:( 56# deep magic, expecially the double indirection :(:(
61sub timeout($) { 57sub timeout($) {
62 my $self = \\my $timer;
63 my $current = $Coro::current; 58 my $current = $Coro::current;
64 $timer = _new_timer(time + $_[0], sub { 59 my $timeout;
65 undef $timer; # set flag 60 bless {
61 timer => AnyEvent->timer (after => $_[0], cb => sub {
62 $timeout = 1;
66 $current->ready; 63 $current->ready;
67 }); 64 }),
68 bless $self, Coro::timeout::; 65 timeout => \$timeout,
66 }, "Coro::Timer::Timeout";
69} 67}
70 68
71package Coro::timeout; 69package Coro::Timer::Timeout;
72 70
73sub bool { 71sub bool { ${$_[0]{timeout}} }
74 !${${$_[0]}}
75}
76
77sub DESTROY {
78 ${${$_[0]}}->cancel;
79 undef ${${$_[0]}}; # without this it leaks like hell. breaks the circular reference inside the closure
80}
81 72
82use overload 'bool' => \&bool, '0+' => \&bool; 73use overload 'bool' => \&bool, '0+' => \&bool;
83 74
84package Coro::Timer; 75package Coro::Timer;
85 76
… …
89and, most important, without blocking other coroutines. 80and, most important, without blocking other coroutines.
90 81
91=cut 82=cut
92 83
93sub sleep { 84sub sleep {
94 my $current = $Coro::current; 85 my $timer = AnyEvent->timer (after => $_[0], cb => Coro::rouse_cb);
95 my $timer = _new_timer(time + $_[0], sub { $current->ready }); 86 Coro::rouse_wait;
96 Coro::schedule;
97 $timer->cancel;
98} 87}
99
100=item $timer = new Coro::Timer at/after => xxx, cb => \&yyy;
101
102Create a new timer.
103
104=cut
105
106sub new {
107 my $class = shift;
108 my %arg = @_;
109
110 $arg{at} = time + delete $arg{after} if exists $arg{after};
111
112 _new_timer($arg{at}, $arg{cb});
113}
114
115my $timer;
116my @timer;
117
118unless ($override) {
119 $override = 1;
120 *_new_timer = sub {
121 my $self = bless [$_[0], $_[1]], Coro::Timer::simple;
122
123 # my version of rapid prototyping. guys, use a real event module!
124 @timer = sort { $a->[0] cmp $b->[0] } @timer, $self;
125
126 unless ($timer) {
127 $timer = new Coro sub {
128 my $NOW = time;
129 while (@timer) {
130 Coro::cede;
131 if ($NOW >= $timer[0][0]) {
132 my $next = shift @timer;
133 $next->[1] and $next->[1]->();
134 } else {
135 select undef, undef, undef, $timer[0][0] - $NOW;
136 $NOW = time;
137 }
138 };
139 undef $timer;
140 };
141 $timer->prio(Coro::PRIO_MIN);
142 $timer->ready;
143 }
144
145 $self;
146 };
147
148 *Coro::Timer::simple::cancel = sub {
149 @{$_[0]} = ();
150 };
151}
152
153=item $timer->cancel
154
155Cancel the timer (the callback will no longer be called). This method MUST
156be called to remove the timer from memory, otherwise it will never be
157freed!
158
159=cut
160 88
1611; 891;
162 90
163=back 91=back
164 92
165=head1 AUTHOR 93=head1 AUTHOR
166 94
167 Marc Lehmann <pcg@goof.com> 95 Marc Lehmann <schmorp@schmorp.de>
168 http://www.goof.com/pcg/marc/ 96 http://home.schmorp.de/
169 97
170=cut 98=cut
171 99

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines