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.533;
@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 }

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;
   _new_timer(time + $_[0], sub { $current->ready });
   Coro::schedule;
}

=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).

=cut

1;

=back

=head1 AUTHOR

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

=cut

Revision:	1.8
Committed:	Mon Feb 25 03:21:09 2002 UTC (22 years, 4 months ago) by root
Branch:	MAIN
Changes since 1.7:	+5 -2 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.8	$VERSION = 0.533;
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			sub bool { !${${$_[0]}} }
74			sub DESTROY { ${${$_[0]}}->cancel }
75
76			use overload 'bool' => \&bool, '0+' => \&bool;
77
78			package Coro::Timer;
79
80	root	1.4	=item sleep $seconds
81
82			This function works like the built-in sleep, except maybe more precise
83			and, most important, without blocking other coroutines.
84
85			=cut
86
87			sub sleep {
88			my $current = $Coro::current;
89			_new_timer(time + $_[0], sub { $current->ready });
90			Coro::schedule;
91			}
92
93	root	1.1	=item $timer = new Coro::Timer at/after => xxx, cb => \&yyy;
94
95			Create a new timer.
96
97			=cut
98
99			sub new {
100			my $class = shift;
101			my %arg = @_;
102
103			$arg{at} = time + delete $arg{after} if exists $arg{after};
104
105	root	1.4	_new_timer($arg{at}, $arg{cb});
106	root	1.1	}
107
108			my $timer;
109			my @timer;
110
111			unless ($override) {
112			$override = 1;
113			*_new_timer = sub {
114	root	1.4	my $self = bless [$_[0], $_[1]], Coro::Timer::simple;
115	root	1.1
116			# my version of rapid prototyping. guys, use a real event module!
117			@timer = sort { $a->[0] cmp $b->[0] } @timer, $self;
118
119			unless ($timer) {
120			$timer = new Coro sub {
121			my $NOW = time;
122			while (@timer) {
123			Coro::cede;
124			if ($NOW >= $timer[0][0]) {
125			my $next = shift @timer;
126			$next->[1] and $next->[1]->();
127			} else {
128			select undef, undef, undef, $timer[0][0] - $NOW;
129			$NOW = time;
130			}
131			};
132			undef $timer;
133			};
134			$timer->prio(Coro::PRIO_MIN);
135			$timer->ready;
136			}
137
138			$self;
139			};
140
141	root	1.4	*Coro::Timer::simple::cancel = sub {
142	root	1.3	@{$_[0]} = ();
143	root	1.1	};
144			}
145
146			=item $timer->cancel
147
148			Cancel the timer (the callback will no longer be called).
149
150			=cut
151
152			1;
153
154			=back
155
156			=head1 AUTHOR
157
158			Marc Lehmann <pcg@goof.com>
159			http://www.goof.com/pcg/marc/
160
161			=cut
162