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.1 by root, Sun Nov 25 20:04:05 2001 UTC vs.
Revision 1.28 by root, Mon Dec 12 20:31:23 2005 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
13used, it is emulated. The C<Coro::Event> module overwrites functions with 16used, it is emulated. The C<Coro::Event> module overwrites functions with
14versions better suited. 17versions better suited.
15 18
19This module is not subclassable.
20
16=over 4 21=over 4
17 22
18=cut 23=cut
19 24
20package Coro::Timer; 25package Coro::Timer;
21 26
22no warnings qw(uninitialized); 27BEGIN { eval { require warnings } && warnings->unimport ("uninitialized") }
23 28
24use Carp (); 29use Carp ();
30use Exporter;
25 31
26use Coro (); 32use Coro ();
27 33
34BEGIN {
28BEGIN { eval "use Time::HiRes 'time'" } 35 eval "use Time::HiRes 'time'";
36}
29 37
30$VERSION = 0.52; 38$VERSION = 1.6;
39@EXPORT_OK = qw(timeout sleep);
40
41=item $flag = timeout $seconds;
42
43This function will wake up the current coroutine after $seconds
44seconds and sets $flag to true (it is false initially). If $flag goes
45out of scope earlier nothing happens. This is used to implement the
46C<timed_down>, C<timed_wait> etc. primitives. It is used like this:
47
48 sub timed_wait {
49 my $timeout = Coro::Timer::timeout 60;
50
51 while (condition false) {
52 schedule; # wait until woken up or timeout
53 return 0 if $timeout; # timed out
54 }
55 return 1; # condition satisfied
56 }
57
58=cut
59
60# deep magic, expecially the double indirection :(:(
61sub timeout($) {
62 my $self = \\my $timer;
63 my $current = $Coro::current;
64 $timer = _new_timer(time + $_[0], sub {
65 undef $timer; # set flag
66 $current->ready;
67 });
68 bless $self, Coro::timeout::;
69}
70
71package Coro::timeout;
72
73sub bool {
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
82use overload 'bool' => \&bool, '0+' => \&bool;
83
84package Coro::Timer;
85
86=item sleep $seconds
87
88This function works like the built-in sleep, except maybe more precise
89and, most important, without blocking other coroutines.
90
91=cut
92
93sub sleep {
94 my $current = $Coro::current;
95 my $timer = _new_timer(time + $_[0], sub { $current->ready });
96 Coro::schedule;
97 $timer->cancel;
98}
31 99
32=item $timer = new Coro::Timer at/after => xxx, cb => \&yyy; 100=item $timer = new Coro::Timer at/after => xxx, cb => \&yyy;
33 101
34Create a new timer. 102Create a new timer.
35 103
… …
39 my $class = shift; 107 my $class = shift;
40 my %arg = @_; 108 my %arg = @_;
41 109
42 $arg{at} = time + delete $arg{after} if exists $arg{after}; 110 $arg{at} = time + delete $arg{after} if exists $arg{after};
43 111
44 _new_timer($class, $arg{at}, $arg{cb}); 112 _new_timer($arg{at}, $arg{cb});
45} 113}
46 114
47my $timer; 115my $timer;
48my @timer; 116my @timer;
49 117
50unless ($override) { 118unless ($override) {
51 $override = 1; 119 $override = 1;
52 *_new_timer = sub { 120 *_new_timer = sub {
53 my $self = bless [$_[1], $_[2]], $_[0]; 121 my $self = bless [$_[0], $_[1]], Coro::Timer::simple;
54 122
55 # my version of rapid prototyping. guys, use a real event module! 123 # my version of rapid prototyping. guys, use a real event module!
56 @timer = sort { $a->[0] cmp $b->[0] } @timer, $self; 124 @timer = sort { $a->[0] cmp $b->[0] } @timer, $self;
57 125
58 unless ($timer) { 126 unless ($timer) {
… …
66 } else { 134 } else {
67 select undef, undef, undef, $timer[0][0] - $NOW; 135 select undef, undef, undef, $timer[0][0] - $NOW;
68 $NOW = time; 136 $NOW = time;
69 } 137 }
70 }; 138 };
71 print "hihohihoh ($timer, $timer->{_coro_state})\n";
72 print "hihohihoy $Coro::current\n";
73 use Devel::Peek;
74 #Dump($timer);
75 undef $timer; 139 undef $timer;
76 print "hihohihox $Coro::current\n";
77 }; 140 };
78 $timer->prio(Coro::PRIO_MIN); 141 $timer->prio(Coro::PRIO_MIN);
79 $timer->ready; 142 $timer->ready;
80 } 143 }
81 144
82 $self; 145 $self;
83 }; 146 };
84 147
85 *cancel = sub { 148 *Coro::Timer::simple::cancel = sub {
86 undef $_[0][1]; 149 @{$_[0]} = ();
87 }; 150 };
88} 151}
89 152
90=item $timer->cancel 153=item $timer->cancel
91 154
92Cancel the timer (the callback will no longer be called). 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!
93 158
94=cut 159=cut
95 160
961; 1611;
97 162
98=back 163=back
99 164
100=head1 AUTHOR 165=head1 AUTHOR
101 166
102 Marc Lehmann <pcg@goof.com> 167 Marc Lehmann <schmorp@schmorp.de>
103 http://www.goof.com/pcg/marc/ 168 http://home.schmorp.de/
104 169
105=cut 170=cut
106 171

Diff Legend

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