Coro/Coro/Timer.pm

=head1 NAME

Coro::Timer - simple timer package, independent of used event loops

=head1 SYNOPSIS

 use Coro::Timer qw(sleep timeout);
 # nothing exported by default

 sleep 10;

=head1 DESCRIPTION

This package implements a simple timer callback system which works
independent of the event loop mechanism used. If no event mechanism is
used, it is emulated. The C<Coro::Event> module overwrites functions with
versions better suited.

This module is not subclassable.

=over 4

=cut

package Coro::Timer;

no warnings qw(uninitialized);

use Carp ();
use Exporter;

use Coro ();

BEGIN {
   eval "use Time::HiRes 'time'";
}

$VERSION = 0.7;
@EXPORT_OK = qw(timeout sleep);

=item $flag = timeout $seconds;

This function will wake up the current coroutine after $seconds
seconds and sets $flag to true (it is false intiially).  If $flag goes
out of scope earlier nothing happens. This is used to implement the
C<timed_down>, C<timed_wait> etc. primitives. It is used like this:

   sub timed_wait {
      my $timeout = Coro::Timer::timeout 60;

      while (condition false) {
         schedule; # wait until woken up or timeout
         return 0 if $timeout; # timed out
      }
      return 1; # condition satisfied
   }

=cut

# deep magic, expecially the double indirection :(:(
sub timeout($) {
   my $self = \\my $timer;
   my $current = $Coro::current;
   $timer = _new_timer(time + $_[0], sub {
      undef $timer; # set flag
      $current->ready;
   });
   bless $self, Coro::timeout::;
}

package Coro::timeout;

sub bool    {
   !${${$_[0]}}
}

sub DESTROY { 
   ${${$_[0]}}->cancel;
   undef ${${$_[0]}}; # without this it leaks like hell. breaks the circular reference inside the closure
}

use overload 'bool' => \&bool, '0+' => \&bool;

package Coro::Timer;

=item sleep $seconds

This function works like the built-in sleep, except maybe more precise
and, most important, without blocking other coroutines.

=cut

sub sleep {
   my $current = $Coro::current;
   my $timer = _new_timer(time + $_[0], sub { $current->ready });
   Coro::schedule;
   $timer->cancel;
}

=item $timer = new Coro::Timer at/after => xxx, cb => \&yyy;

Create a new timer.

=cut

sub new {
   my $class = shift;
   my %arg = @_;

   $arg{at} = time + delete $arg{after} if exists $arg{after};

   _new_timer($arg{at}, $arg{cb});
}

my $timer;
my @timer;

unless ($override) {
   $override = 1;
   *_new_timer = sub {
      my $self = bless [$_[0], $_[1]], Coro::Timer::simple;

      # my version of rapid prototyping. guys, use a real event module!
      @timer = sort { $a->[0] cmp $b->[0] } @timer, $self;

      unless ($timer) {
         $timer = new Coro sub {
            my $NOW = time;
            while (@timer) {
               Coro::cede;
               if ($NOW >= $timer[0][0]) {
                  my $next = shift @timer;
                  $next->[1] and $next->[1]->();
               } else {
                  select undef, undef, undef, $timer[0][0] - $NOW;
                  $NOW = time;
               }
            };
            undef $timer;
         };
         $timer->prio(Coro::PRIO_MIN);
         $timer->ready;
      }

      $self;
   };

   *Coro::Timer::simple::cancel = sub {
      @{$_[0]} = ();
   };
}

=item $timer->cancel

Cancel the timer (the callback will no longer be called). This method MUST
be called to remove the timer from memory, otherwise it will never be
freed!

=cut

1;

=back

=head1 AUTHOR

 Marc Lehmann <pcg@goof.com>
 http://www.goof.com/pcg/marc/

=cut

Revision:	1.13
Committed:	Tue May 27 01:15:31 2003 UTC (21 years ago) by root
Branch:	MAIN
Changes since 1.12:	+1 -1 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	=head1 NAME
2
3			Coro::Timer - simple timer package, independent of used event loops
4
5			=head1 SYNOPSIS
6
7	root	1.8	use Coro::Timer qw(sleep timeout);
8			# nothing exported by default
9
10			sleep 10;
11	root	1.1
12			=head1 DESCRIPTION
13
14			This package implements a simple timer callback system which works
15			independent of the event loop mechanism used. If no event mechanism is
16			used, it is emulated. The C<Coro::Event> module overwrites functions with
17			versions better suited.
18
19	root	1.4	This module is not subclassable.
20
21	root	1.1	=over 4
22
23			=cut
24
25			package Coro::Timer;
26
27			no warnings qw(uninitialized);
28
29			use Carp ();
30	root	1.4	use Exporter;
31	root	1.1
32			use Coro ();
33
34	root	1.4	BEGIN {
35			eval "use Time::HiRes 'time'";
36			}
37	root	1.1
38	root	1.13	$VERSION = 0.7;
39	root	1.4	@EXPORT_OK = qw(timeout sleep);
40	root	1.1
41	root	1.4	=item $flag = timeout $seconds;
42	root	1.3
43			This function will wake up the current coroutine after $seconds
44			seconds and sets $flag to true (it is false intiially). If $flag goes
45			out of scope earlier nothing happens. This is used to implement the
46	root	1.4	C<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	root	1.3
58			=cut
59
60			# deep magic, expecially the double indirection :(:(
61			sub timeout($) {
62			my $self = \\my $timer;
63			my $current = $Coro::current;
64	root	1.4	$timer = _new_timer(time + $_[0], sub {
65	root	1.3	undef $timer; # set flag
66			$current->ready;
67			});
68			bless $self, Coro::timeout::;
69			}
70
71			package Coro::timeout;
72
73	root	1.9	sub bool {
74			!${${$_[0]}}
75			}
76
77			sub DESTROY {
78			${${$_[0]}}->cancel;
79			undef ${${$_[0]}}; # without this it leaks like hell. breaks the circular reference inside the closure
80			}
81	root	1.3
82			use overload 'bool' => \&bool, '0+' => \&bool;
83
84			package Coro::Timer;
85
86	root	1.4	=item sleep $seconds
87
88			This function works like the built-in sleep, except maybe more precise
89			and, most important, without blocking other coroutines.
90
91			=cut
92
93			sub sleep {
94			my $current = $Coro::current;
95	root	1.9	my $timer = _new_timer(time + $_[0], sub { $current->ready });
96	root	1.4	Coro::schedule;
97	root	1.9	$timer->cancel;
98	root	1.4	}
99
100	root	1.1	=item $timer = new Coro::Timer at/after => xxx, cb => \&yyy;
101
102			Create a new timer.
103
104			=cut
105
106			sub new {
107			my $class = shift;
108			my %arg = @_;
109
110			$arg{at} = time + delete $arg{after} if exists $arg{after};
111
112	root	1.4	_new_timer($arg{at}, $arg{cb});
113	root	1.1	}
114
115			my $timer;
116			my @timer;
117
118			unless ($override) {
119			$override = 1;
120			*_new_timer = sub {
121	root	1.4	my $self = bless [$_[0], $_[1]], Coro::Timer::simple;
122	root	1.1
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	root	1.4	*Coro::Timer::simple::cancel = sub {
149	root	1.3	@{$_[0]} = ();
150	root	1.1	};
151			}
152
153			=item $timer->cancel
154
155	root	1.9	Cancel the timer (the callback will no longer be called). This method MUST
156			be called to remove the timer from memory, otherwise it will never be
157			freed!
158	root	1.1
159			=cut
160
161			1;
162
163			=back
164
165			=head1 AUTHOR
166
167			Marc Lehmann <pcg@goof.com>
168			http://www.goof.com/pcg/marc/
169
170			=cut
171