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.3 by root, Tue Nov 27 02:51:03 2001 UTC vs.
Revision 1.57 by root, Thu Nov 20 14:57:45 2008 UTC

… …
2 2
3Coro::Timer - simple timer package, independent of used event loops 3Coro::Timer - simple timer package, independent of used event loops
4 4
5=head1 SYNOPSIS 5=head1 SYNOPSIS
6 6
7 use Coro::Timer; 7 use Coro::Timer qw(sleep timeout);
8 # nothing exported by default
9
10 sleep 10;
8 11
9=head1 DESCRIPTION 12=head1 DESCRIPTION
10 13
11This package implements a simple timer callback system which works 14This package implements a simple timer callback system which works
12independent of the event loop mechanism used. If no event mechanism is 15independent of the event loop mechanism used.
13used, it is emulated. The C<Coro::Event> module overwrites functions with
14versions better suited.
15 16
16=over 4 17=over 4
17 18
18=cut 19=cut
19 20
20package Coro::Timer; 21package Coro::Timer;
21 22
22no warnings qw(uninitialized); 23no warnings;
23 24
24use Carp (); 25use Carp ();
26use Exporter;
27
28use AnyEvent ();
25 29
26use Coro (); 30use Coro ();
31use Coro::AnyEvent ();
27 32
28BEGIN { eval "use Time::HiRes 'time'" } 33$VERSION = "5.0";
34@EXPORT_OK = qw(timeout sleep);
29 35
30$VERSION = 0.52;
31
32=item $flag = Coro::Timer::timeout $seconds; 36=item $flag = timeout $seconds;
33 37
34This function will wake up the current coroutine after $seconds 38This function will wake up the current coroutine after $seconds
35seconds 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
36out of scope earlier nothing happens. This is used to implement the 40out of scope earlier nothing happens. This is used to implement the
37C<timed_down>, C<timed_wait> etc. primitives. 41C<timed_down>, C<timed_wait> etc. primitives. It is used like this:
42
43 sub timed_wait {
44 my $timeout = Coro::Timer::timeout 60;
45
46 while (condition false) {
47 Coro::schedule; # wait until woken up or timeout
48 return 0 if $timeout; # timed out
49 }
50
51 return 1; # condition satisfied
52 }
38 53
39=cut 54=cut
40 55
41# deep magic, expecially the double indirection :(:( 56# deep magic, expecially the double indirection :(:(
42sub timeout($) { 57sub timeout($) {
43 my $self = \\my $timer;
44 my $current = $Coro::current; 58 my $current = $Coro::current;
45 $timer = _new_timer(Coro::Timer, time + $_[0], sub { 59 my $timeout;
46 undef $timer; # set flag 60 bless {
61 timer => AnyEvent->timer (after => $_[0], cb => sub {
62 $timeout = 1;
47 $current->ready; 63 $current->ready;
48 }); 64 }),
49 bless $self, Coro::timeout::; 65 timeout => \$timeout,
66 }, "Coro::Timer::Timeout";
50} 67}
51 68
52package Coro::timeout; 69package Coro::Timer::Timeout;
53 70
54sub bool { !${${$_[0]}} } 71sub bool { ${$_[0]{timeout}} }
55sub DESTROY { ${${$_[0]}}->cancel }
56 72
57use overload 'bool' => \&bool, '0+' => \&bool; 73use overload 'bool' => \&bool, '0+' => \&bool;
58 74
59package Coro::Timer; 75package Coro::Timer;
60 76
61=item $timer = new Coro::Timer at/after => xxx, cb => \&yyy; 77=item sleep $seconds
62 78
63Create a new timer. 79This function works like the built-in sleep, except maybe more precise
80and, most important, without blocking other coroutines.
64 81
65=cut 82=cut
66 83
67sub new { 84sub sleep {
68 my $class = shift; 85 my $timer = AnyEvent->timer (after => $_[0], cb => Coro::rouse_cb);
69 my %arg = @_; 86 Coro::rouse_wait;
70
71 $arg{at} = time + delete $arg{after} if exists $arg{after};
72
73 _new_timer($class, $arg{at}, $arg{cb});
74} 87}
75
76my $timer;
77my @timer;
78
79unless ($override) {
80 $override = 1;
81 *_new_timer = sub {
82 my $self = bless [$_[1], $_[2]], $_[0];
83
84 # my version of rapid prototyping. guys, use a real event module!
85 @timer = sort { $a->[0] cmp $b->[0] } @timer, $self;
86
87 unless ($timer) {
88 $timer = new Coro sub {
89 my $NOW = time;
90 while (@timer) {
91 Coro::cede;
92 if ($NOW >= $timer[0][0]) {
93 my $next = shift @timer;
94 $next->[1] and $next->[1]->();
95 } else {
96 select undef, undef, undef, $timer[0][0] - $NOW;
97 $NOW = time;
98 }
99 };
100 undef $timer;
101 };
102 $timer->prio(Coro::PRIO_MIN);
103 $timer->ready;
104 }
105
106 $self;
107 };
108
109 *cancel = sub {
110 @{$_[0]} = ();
111 };
112}
113
114=item $timer->cancel
115
116Cancel the timer (the callback will no longer be called).
117
118=cut
119 88
1201; 891;
121 90
122=back 91=back
123 92
124=head1 AUTHOR 93=head1 AUTHOR
125 94
126 Marc Lehmann <pcg@goof.com> 95 Marc Lehmann <schmorp@schmorp.de>
127 http://www.goof.com/pcg/marc/ 96 http://home.schmorp.de/
128 97
129=cut 98=cut
130 99

Diff Legend

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