File Coverage

blib/lib/Event/Schedule.pm
Criterion Covered Total %
statement 6 24 25.0
branch 0 4 0.0
condition n/a
subroutine 2 5 40.0
pod 3 3 100.0
total 11 36 30.5


line stmt bran cond sub pod time code
1             package Event::Schedule;
2              
3 1     1   23299 use warnings;
  1         3  
  1         35  
4 1     1   6 use strict;
  1         1  
  1         333  
5              
6             =head1 NAME
7              
8             Event::Schedule - A simple way to organize timed events in, say, an IRC bot.
9              
10             =head1 VERSION
11              
12             Version 0.01
13              
14             =cut
15              
16             our $VERSION = '0.02';
17              
18              
19             =head1 SYNOPSIS
20              
21             This class implements a very simple event schedule to be used in-process for simple functionality.
22             It was developed in the context of an IRC bot to enforce Roberts Rules of Order on a channel;
23             when someone is given the floor for a minute, we can simply schedule a call to a warning function in
24             60 seconds. We set a timer to call the event queue every second.
25              
26             Obviously, long-running functions should not be called here. Use threads for that.
27              
28             The event itself is a closure, or anonymous coderef. This makes it easy to encapsulate a given call
29             with its parameters. If you've never encountered closures before, then this is your lucky day.
30              
31             use Event::Schedule;
32              
33             my $queue = Event::Schedule->new();
34              
35             # Let's schedule an event for a minute from now.
36             $queue->add (60, sub { my_function ($a, $b); });
37              
38             ... (we wait 60 seconds) ...
39             $queue->tick(); # My function executes.
40              
41             Future functionality could include a queue lister and perhaps some callback way to remove obsolete
42             events from the queue.
43              
44             =head1 FUNCTIONS
45              
46             =head2 new()
47              
48             Creates a new event queue. Notes the time when it does so.
49              
50             =cut
51              
52             sub new {
53 0     0 1   my ($class) = @_;
54 0           my $self = { last_tick => time,
55             queue => {}
56             };
57 0           bless $self, $class;
58 0           return $self;
59             }
60              
61             =head2 add($time, $event)
62              
63             Adds a scheduled event to be run after I
64              
65             =cut
66              
67             sub add {
68 0     0 1   my ($self, $time, $event) = @_;
69              
70 0           $time += time(); # Time is given in seconds from right now.
71 0 0         $self->{queue}->{$time} = [] unless $self->{queue}->{$time};
72 0           push @{$self->{queue}->{$time}}, $event;
  0            
73             }
74              
75             =head2 tick()
76              
77             Call this every second to run all the closures scheduled for every second between the last tick and the time noe.
78              
79             =cut
80              
81             sub tick {
82 0     0 1   my ($self) = @_;
83              
84 0           my $time;
85 0           for ($time = $self->{last_tick},
86             $time <= time(),
87             $time++) {
88 0 0         if ($self->{queue}->{$time}) {
89 0           my $v = $self->{queue}->{$time};
90 0           delete $self->{queue}->{$time};
91 0           foreach my $event (@$v) {
92 0           &$event(); # It's a closure!
93             }
94             }
95             }
96 0           $self->{last_tick} = time();
97             }
98              
99              
100             =head1 AUTHOR
101              
102             Michael Roberts, C<< >>
103              
104             =head1 BUGS
105              
106             Please report any bugs or feature requests to C, or through
107             the web interface at L. I will be notified, and then you'll
108             automatically be notified of progress on your bug as I make changes.
109              
110              
111              
112              
113             =head1 SUPPORT
114              
115             You can find documentation for this module with the perldoc command.
116              
117             perldoc Event::Schedule
118              
119              
120             You can also look for information at:
121              
122             =over 4
123              
124             =item * RT: CPAN's request tracker
125              
126             L
127              
128             =item * AnnoCPAN: Annotated CPAN documentation
129              
130             L
131              
132             =item * CPAN Ratings
133              
134             L
135              
136             =item * Search CPAN
137              
138             L
139              
140             =back
141              
142              
143             =head1 ACKNOWLEDGEMENTS
144              
145              
146             =head1 COPYRIGHT & LICENSE
147              
148             Copyright 2010 Michael Roberts, all rights reserved.
149              
150             This program is free software; you can redistribute it and/or modify it
151             under the same terms as Perl itself.
152              
153              
154             =cut
155              
156             1; # End of Event::Schedule