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.6 by root, Mon Dec 10 21:18:30 2001 UTC vs.
Revision 1.53 by root, Mon Nov 10 04:37:23 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
16This module is not subclassable.
17 16
18=over 4 17=over 4
19 18
20=cut 19=cut
21 20
22package Coro::Timer; 21package Coro::Timer;
23 22
24no warnings qw(uninitialized); 23no warnings;
25 24
26use Carp (); 25use Carp ();
27use Exporter; 26use Exporter;
28 27
28use AnyEvent ();
29
29use Coro (); 30use Coro ();
31use Coro::AnyEvent ();
30 32
31BEGIN {
32 eval "use Time::HiRes 'time'";
33}
34
35$VERSION = 0.531; 33$VERSION = 4.91;
36@EXPORT_OK = qw(timeout sleep); 34@EXPORT_OK = qw(timeout sleep);
37 35
38=item $flag = timeout $seconds; 36=item $flag = timeout $seconds;
39 37
40This function will wake up the current coroutine after $seconds 38This function will wake up the current coroutine after $seconds
41seconds 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
42out of scope earlier nothing happens. This is used to implement the 40out of scope earlier nothing happens. This is used to implement the
43C<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:
44 42
45 sub timed_wait { 43 sub timed_wait {
46 my $timeout = Coro::Timer::timeout 60; 44 my $timeout = Coro::Timer::timeout 60;
47 45
48 while (condition false) { 46 while (condition false) {
49 schedule; # wait until woken up or timeout 47 Coro::schedule; # wait until woken up or timeout
50 return 0 if $timeout; # timed out 48 return 0 if $timeout; # timed out
51 } 49 }
50
52 return 1; # condition satisfied 51 return 1; # condition satisfied
53 } 52 }
54 53
55=cut 54=cut
56 55
57# deep magic, expecially the double indirection :(:( 56# deep magic, expecially the double indirection :(:(
58sub timeout($) { 57sub timeout($) {
59 my $self = \\my $timer;
60 my $current = $Coro::current; 58 my $current = $Coro::current;
61 $timer = _new_timer(time + $_[0], sub { 59 my $timeout;
62 undef $timer; # set flag 60 bless {
61 timer => AnyEvent->timer (after => $_[0], cb => sub {
62 $timeout = 1;
63 $current->ready; 63 $current->ready;
64 }); 64 }),
65 bless $self, Coro::timeout::; 65 timeout => \$timeout,
66 }, "Coro::Timer::Timeout";
66} 67}
67 68
68package Coro::timeout; 69package Coro::Timer::Timeout;
69 70
70sub bool { !${${$_[0]}} } 71sub bool { ${$_[0]{timeout}} }
71sub DESTROY { ${${$_[0]}}->cancel }
72 72
73use overload 'bool' => \&bool, '0+' => \&bool; 73use overload 'bool' => \&bool, '0+' => \&bool;
74 74
75package Coro::Timer; 75package Coro::Timer;
76 76
… …
81 81
82=cut 82=cut
83 83
84sub sleep { 84sub sleep {
85 my $current = $Coro::current; 85 my $current = $Coro::current;
86 _new_timer(time + $_[0], sub { $current->ready }); 86
87 Coro::schedule; 87 my $timer = AnyEvent->timer (after => $_[0], cb => sub {
88 $current->ready;
89 undef $current;
90 });
91
92 do { &Coro::schedule } while $current;
88} 93}
89
90=item $timer = new Coro::Timer at/after => xxx, cb => \&yyy;
91
92Create a new timer.
93
94=cut
95
96sub new {
97 my $class = shift;
98 my %arg = @_;
99
100 $arg{at} = time + delete $arg{after} if exists $arg{after};
101
102 _new_timer($arg{at}, $arg{cb});
103}
104
105my $timer;
106my @timer;
107
108unless ($override) {
109 $override = 1;
110 *_new_timer = sub {
111 my $self = bless [$_[0], $_[1]], Coro::Timer::simple;
112
113 # my version of rapid prototyping. guys, use a real event module!
114 @timer = sort { $a->[0] cmp $b->[0] } @timer, $self;
115
116 unless ($timer) {
117 $timer = new Coro sub {
118 my $NOW = time;
119 while (@timer) {
120 Coro::cede;
121 if ($NOW >= $timer[0][0]) {
122 my $next = shift @timer;
123 $next->[1] and $next->[1]->();
124 } else {
125 select undef, undef, undef, $timer[0][0] - $NOW;
126 $NOW = time;
127 }
128 };
129 undef $timer;
130 };
131 $timer->prio(Coro::PRIO_MIN);
132 $timer->ready;
133 }
134
135 $self;
136 };
137
138 *Coro::Timer::simple::cancel = sub {
139 @{$_[0]} = ();
140 };
141}
142
143=item $timer->cancel
144
145Cancel the timer (the callback will no longer be called).
146
147=cut
148 94
1491; 951;
150 96
151=back 97=back
152 98
153=head1 AUTHOR 99=head1 AUTHOR
154 100
155 Marc Lehmann <pcg@goof.com> 101 Marc Lehmann <schmorp@schmorp.de>
156 http://www.goof.com/pcg/marc/ 102 http://home.schmorp.de/
157 103
158=cut 104=cut
159 105

Diff Legend

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