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.

=over 4

=cut

package Coro::Timer;

no warnings qw(uninitialized);

use Carp ();

use Coro ();

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

$VERSION = 0.52;

=item $flag = Coro::Timer::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.

=cut

# deep magic, expecially the double indirection :(:(
sub timeout($) {
   my $self = \\my $timer;
   my $current = $Coro::current;
   $timer = _new_timer(Coro::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 $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($class, $arg{at}, $arg{cb});
}

my $timer;
my @timer;

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

      # 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;
   };

   *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.3
Committed:	Tue Nov 27 02:51:03 2001 UTC (22 years, 8 months ago) by root
Branch:	MAIN
Changes since 1.2:	+30 -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			=over 4
17
18			=cut
19
20			package Coro::Timer;
21
22			no warnings qw(uninitialized);
23
24			use Carp ();
25
26			use Coro ();
27
28			BEGIN { eval "use Time::HiRes 'time'" }
29
30			$VERSION = 0.52;
31
32	root	1.3	=item $flag = Coro::Timer::timeout $seconds;
33
34			This function will wake up the current coroutine after $seconds
35			seconds and sets $flag to true (it is false intiially). If $flag goes
36			out of scope earlier nothing happens. This is used to implement the
37			C<timed_down>, C<timed_wait> etc. primitives.
38
39			=cut
40
41			# deep magic, expecially the double indirection :(:(
42			sub timeout($) {
43			my $self = \\my $timer;
44			my $current = $Coro::current;
45			$timer = _new_timer(Coro::Timer, time + $_[0], sub {
46			undef $timer; # set flag
47			$current->ready;
48			});
49			bless $self, Coro::timeout::;
50			}
51
52			package Coro::timeout;
53
54			sub bool { !${${$_[0]}} }
55			sub DESTROY { ${${$_[0]}}->cancel }
56
57			use overload 'bool' => \&bool, '0+' => \&bool;
58
59			package Coro::Timer;
60
61	root	1.1	=item $timer = new Coro::Timer at/after => xxx, cb => \&yyy;
62
63			Create a new timer.
64
65			=cut
66
67			sub new {
68			my $class = shift;
69			my %arg = @_;
70
71			$arg{at} = time + delete $arg{after} if exists $arg{after};
72
73			_new_timer($class, $arg{at}, $arg{cb});
74			}
75
76			my $timer;
77			my @timer;
78
79			unless ($override) {
80			$override = 1;
81			*_new_timer = sub {
82			my $self = bless [$_[1], $_[2]], $_[0];
83
84			# my version of rapid prototyping. guys, use a real event module!
85			@timer = sort { $a->[0] cmp $b->[0] } @timer, $self;
86
87			unless ($timer) {
88			$timer = new Coro sub {
89			my $NOW = time;
90			while (@timer) {
91			Coro::cede;
92			if ($NOW >= $timer[0][0]) {
93			my $next = shift @timer;
94			$next->[1] and $next->[1]->();
95			} else {
96			select undef, undef, undef, $timer[0][0] - $NOW;
97			$NOW = time;
98			}
99			};
100			undef $timer;
101			};
102			$timer->prio(Coro::PRIO_MIN);
103			$timer->ready;
104			}
105
106			$self;
107			};
108
109			*cancel = sub {
110	root	1.3	@{$_[0]} = ();
111	root	1.1	};
112			}
113
114			=item $timer->cancel
115
116			Cancel the timer (the callback will no longer be called).
117
118			=cut
119
120			1;
121
122			=back
123
124			=head1 AUTHOR
125
126			Marc Lehmann <pcg@goof.com>
127			http://www.goof.com/pcg/marc/
128
129			=cut
130