Coro/Coro/Timer.pm

=head1 NAME

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

=head1 SYNOPSIS

 use Coro::Timer;

=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.531;
@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.6
Committed:	Mon Dec 10 21:18:30 2001 UTC (22 years, 6 months ago) by root
Branch:	MAIN
Changes since 1.5:	+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			use Coro::Timer;
8
9			=head1 DESCRIPTION
10
11			This package implements a simple timer callback system which works
12			independent of the event loop mechanism used. If no event mechanism is
13			used, it is emulated. The C<Coro::Event> module overwrites functions with
14			versions better suited.
15
16	root	1.4	This module is not subclassable.
17
18	root	1.1	=over 4
19
20			=cut
21
22			package Coro::Timer;
23
24			no warnings qw(uninitialized);
25
26			use Carp ();
27	root	1.4	use Exporter;
28	root	1.1
29			use Coro ();
30
31	root	1.4	BEGIN {
32			eval "use Time::HiRes 'time'";
33			}
34	root	1.1
35	root	1.6	$VERSION = 0.531;
36	root	1.4	@EXPORT_OK = qw(timeout sleep);
37	root	1.1
38	root	1.4	=item $flag = timeout $seconds;
39	root	1.3
40			This function will wake up the current coroutine after $seconds
41			seconds and sets $flag to true (it is false intiially). If $flag goes
42			out of scope earlier nothing happens. This is used to implement the
43	root	1.4	C<timed_down>, C<timed_wait> etc. primitives. It is used like this:
44
45			sub timed_wait {
46			my $timeout = Coro::Timer::timeout 60;
47
48			while (condition false) {
49			schedule; # wait until woken up or timeout
50			return 0 if $timeout; # timed out
51			}
52			return 1; # condition satisfied
53			}
54	root	1.3
55			=cut
56
57			# deep magic, expecially the double indirection :(:(
58			sub timeout($) {
59			my $self = \\my $timer;
60			my $current = $Coro::current;
61	root	1.4	$timer = _new_timer(time + $_[0], sub {
62	root	1.3	undef $timer; # set flag
63			$current->ready;
64			});
65			bless $self, Coro::timeout::;
66			}
67
68			package Coro::timeout;
69
70			sub bool { !${${$_[0]}} }
71			sub DESTROY { ${${$_[0]}}->cancel }
72
73			use overload 'bool' => \&bool, '0+' => \&bool;
74
75			package Coro::Timer;
76
77	root	1.4	=item sleep $seconds
78
79			This function works like the built-in sleep, except maybe more precise
80			and, most important, without blocking other coroutines.
81
82			=cut
83
84			sub sleep {
85			my $current = $Coro::current;
86			_new_timer(time + $_[0], sub { $current->ready });
87			Coro::schedule;
88			}
89
90	root	1.1	=item $timer = new Coro::Timer at/after => xxx, cb => \&yyy;
91
92			Create a new timer.
93
94			=cut
95
96			sub new {
97			my $class = shift;
98			my %arg = @_;
99
100			$arg{at} = time + delete $arg{after} if exists $arg{after};
101
102	root	1.4	_new_timer($arg{at}, $arg{cb});
103	root	1.1	}
104
105			my $timer;
106			my @timer;
107
108			unless ($override) {
109			$override = 1;
110			*_new_timer = sub {
111	root	1.4	my $self = bless [$_[0], $_[1]], Coro::Timer::simple;
112	root	1.1
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	root	1.4	*Coro::Timer::simple::cancel = sub {
139	root	1.3	@{$_[0]} = ();
140	root	1.1	};
141			}
142
143			=item $timer->cancel
144
145			Cancel the timer (the callback will no longer be called).
146
147			=cut
148
149			1;
150
151			=back
152
153			=head1 AUTHOR
154
155			Marc Lehmann <pcg@goof.com>
156			http://www.goof.com/pcg/marc/
157
158			=cut
159