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.33 by root, Fri Nov 24 15:34:33 2006 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. If no event mechanism is
… …
19 22
20=cut 23=cut
21 24
22package Coro::Timer; 25package Coro::Timer;
23 26
24no warnings qw(uninitialized); 27no warnings;
25 28
26use Carp (); 29use Carp ();
27use Exporter; 30use Exporter;
28 31
29use Coro (); 32use Coro ();
33use AnyEvent ();
30 34
31BEGIN {
32 eval "use Time::HiRes 'time'";
33}
34
35$VERSION = 0.531; 35$VERSION = "2.0";
36@EXPORT_OK = qw(timeout sleep); 36@EXPORT_OK = qw(timeout sleep);
37 37
38=item $flag = timeout $seconds; 38=item $flag = timeout $seconds;
39 39
40This function will wake up the current coroutine after $seconds 40This function will wake up the current coroutine after $seconds
41seconds and sets $flag to true (it is false intiially). If $flag goes 41seconds and sets $flag to true (it is false initially). If $flag goes
42out of scope earlier nothing happens. This is used to implement the 42out of scope earlier nothing happens. This is used to implement the
43C<timed_down>, C<timed_wait> etc. primitives. It is used like this: 43C<timed_down>, C<timed_wait> etc. primitives. It is used like this:
44 44
45 sub timed_wait { 45 sub timed_wait {
46 my $timeout = Coro::Timer::timeout 60; 46 my $timeout = Coro::Timer::timeout 60;
… …
54 54
55=cut 55=cut
56 56
57# deep magic, expecially the double indirection :(:( 57# deep magic, expecially the double indirection :(:(
58sub timeout($) { 58sub timeout($) {
59 my $self = \\my $timer;
60 my $current = $Coro::current; 59 my $current = $Coro::current;
61 $timer = _new_timer(time + $_[0], sub { 60 my $timeout;
62 undef $timer; # set flag 61 bless {
62 timer => AnyEvent->timer (after => $_[0], cb => sub {
63 $timeout = 1;
63 $current->ready; 64 $current->ready;
64 }); 65 }),
65 bless $self, Coro::timeout::; 66 timeout => \$timeout,
67 }, "Coro::Timer::Timeout";
66} 68}
67 69
68package Coro::timeout; 70package Coro::Timer::Timeout;
69 71
70sub bool { !${${$_[0]}} } 72sub bool { ${$_[0]{timeout}} }
71sub DESTROY { ${${$_[0]}}->cancel }
72 73
73use overload 'bool' => \&bool, '0+' => \&bool; 74use overload 'bool' => \&bool, '0+' => \&bool;
74 75
75package Coro::Timer; 76package Coro::Timer;
76 77
… …
81 82
82=cut 83=cut
83 84
84sub sleep { 85sub sleep {
85 my $current = $Coro::current; 86 my $current = $Coro::current;
86 _new_timer(time + $_[0], sub { $current->ready }); 87 my $timer = AnyEvent->timer (after => $_[0], cb => sub { $current->ready });
87 Coro::schedule; 88 Coro::schedule;
88} 89}
89 90
90=item $timer = new Coro::Timer at/after => xxx, cb => \&yyy; 91$Coro::idle = sub {
91 92 AnyEvent->one_event;
92Create a new timer. 93};
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