File Coverage

blib/lib/Schedule/RateLimiter.pm
Criterion Covered Total %
statement 38 38 100.0
branch 18 18 100.0
condition 5 7 71.4
subroutine 6 6 100.0
pod 2 2 100.0
total 69 71 97.1


line stmt bran cond sub pod time code
1             package Schedule::RateLimiter;
2             # $Id: RateLimiter.pm,v 1.1 2003/12/04 23:09:10 wright Exp $
3              
4 4     4   163434 use 5.006;
  4         15  
  4         173  
5 4     4   20 use strict;
  4         9  
  4         137  
6 4     4   29 use warnings;
  4         13  
  4         128  
7 4     4   6683 use Time::HiRes;
  4         12674  
  4         26  
8              
9             our $VERSION = 0.01;
10              
11             return 1;
12              
13             =head1 NAME
14              
15             Schedule::RateLimiter - prevent events from happening too quickly.
16              
17             =head1 SYNOPSIS
18              
19             use Schedule::RateLimiter;
20              
21             # Don't let this event happen more than 5 times in a 60 second period.
22             my $throttle = Schedule::RateLimiter->new ( iterations => 5,
23             seconds => 60 );
24              
25             # Cycle forever, but not too fast.
26             while ( 1 ) {
27             $throttle->event();
28             &do_something;
29             }
30              
31              
32             =head1 DESCRIPTION
33              
34             This module provides a way to voluntarily restrict how many times a given
35             action may take place within a specified time frame. Such a tool may be useful
36             if you have written something which periodically polls some public resource and
37             want to ensure that you do not overburden that resource with too many requests.
38              
39             Initially, one might think that solving this problem would be as simple as
40             sleeping for the number of seconds divided by the number of iterations in
41             between each event. However, that would only be correct if the event took no
42             time at all.
43              
44             If you know exactly how much time each event is going to take then you could
45             build an even more complicated one-liner such as this:
46              
47             sleep( (seconds / iterations) - single_event_time )
48              
49             This module is intended to address the other cases when the exact run-time of
50             each event is unknown and variable. This module will try very hard to allow an
51             event to happen as many times as possible without exceeding the specified
52             bounds.
53              
54             For example, suppose you want to write something that checks an 'incoming'
55             directory once a minute for files and then does something with those files if
56             it finds any. If it takes you two seconds to process those files, then you
57             want to wait 58 seconds before polling the directory again. If it takes 30
58             seconds to process those files, then you only want to wait 30 seconds. And if
59             it takes 3 minutes, then you want to poll the directory again immediately as
60             soon as you are done.
61              
62             my $throttle = Schedule::RateLimiter->new ( seconds => 60 );
63             &poll_and_process while ( $throttle->event );
64              
65             =head1 METHODS
66              
67             =cut
68              
69             =head2 C< new() >
70              
71             Creates and returns a new Schedule::RateLimiter object.
72              
73             The constructor takes up to three parameters:
74              
75             =over
76              
77             =item * block (default: true)
78              
79             This parameter accepts a true or false value to set the default "block"
80             behavior on future calls to event(). It makes it more convenient to turn
81             blocking off for an entire object at a time.
82              
83             =item * iterations (default: 1)
84              
85             This specifies the number of times an event may take place within the given
86             time period. This must be a positive, non-zero integer.
87              
88             =item * seconds (required)
89              
90             This specifies the minimum number of seconds that must transpire before we will
91             allow (iterations + 1) events to happen. A value of 0 disables throttling.
92             You may specify fractional time periods.
93              
94             =back
95              
96             B:
97              
98             my $throttle = Schedule::RateLimiter->new ( iterations => 2,
99             seconds => 10 );
100              
101             # Event 1
102             $throttle->event();
103             # Event 2
104             $throttle->event();
105             # Event 3
106             $throttle->event();
107             # 10 seconds will have transpired since event 1 at this point.
108             # Event 4
109             $throttle->event();
110             # 10 seconds will have transpired since event 2 at this point.
111              
112             =cut
113              
114             sub new {
115 13     13 1 10695 my $proto = shift;
116 13   33     91 my $class = ref($proto) || $proto;
117              
118 13         52 my %args = @_;
119              
120 13 100       55 die "Missing 'seconds' argument" unless defined( $args{seconds} );
121              
122 12 100       64 if ( $args{seconds} =~ /[^-\d\.]/ ) {
123 1         8 die "'seconds' argument must be numeric";
124             }
125              
126 11   100     87 my $iterations = $args{iterations} || 1;
127              
128 11 100       58 if ( $iterations =~ /[^-\d\.]/ ) {
129 2         18 die "'iterations' argument must be numeric";
130             }
131              
132 9 100       50 if ( int($iterations) != $iterations ) {
133 1         10 die "'iterations' argument must be integer";
134             }
135              
136 8 100       34 die "'iterations' argument must be positive" if $iterations < 0;
137              
138 7         14 my @list;
139 7         34 $#list = $iterations -1;
140              
141 7 100       100 bless {
142             current => 0,
143             list => \@list,
144             iterations => $iterations,
145             seconds => $args{seconds},
146             block => ( exists($args{block}) ) ? $args{block} : 1,
147             }, $proto;
148             }
149              
150             =head2 C< event() >
151              
152             Called to signal the beginning of an event. This method will return true or
153             false to indicate if it is ok to proceed with the event. This method uses
154             Time::HiRes to do its calculations and sleeping, so the precision of this
155             method will be the same as the precision of Time::HiRes on your platform.
156              
157             Takes one (optional) parameter:
158              
159             =over
160              
161             =item * block (default: true)
162              
163             If set to a false value, this method will do a non-blocking check to see if it
164             is ok for the event to occur. If it is not ok, this method will return a false
165             value and assume that the event did not take place. Otherwise, this method
166             will return a true value and assume that the event did take place.
167              
168             =back
169              
170             B:
171              
172             # Stop when the code moves too fast.
173             while ( 1 ) {
174             if ($throttle->event( block => 0 )) {
175             &do_something;
176             } else {
177             die 'I went too fast!';
178             }
179             }
180              
181             =cut
182              
183             sub event {
184 230     230 1 165106 my $self = shift;
185 230         820 my %args = @_;
186              
187 230         598 my $t = Time::HiRes::time();
188              
189 230   100     1674 my $last = $self->{list}[$self->{current}] || 0;
190 230 100       1103 my $block = exists( $args{block} ) ? $args{block} : $self->{block};
191              
192 230 100       739 if ( ($t - $last) < $self->{seconds} ) {
193 107 100       3190 return 0 unless $block;
194 3         9002741 Time::HiRes::sleep($self->{seconds} - ($t - $last));
195             }
196              
197 126         327 $self->{list}[$self->{current}] = $t;
198              
199 123         250 $self->{current} = ($self->{current}+1) % $self->{iterations};
200              
201 123         584 return 1;
202             }
203              
204             =head1 BUGS
205              
206             This module needs to keep a record of when every iteration took place, so if
207             you are allowing a large number of iterations to happen in the given time
208             period, this could potentially use a lot of memory.
209              
210             =head1 KNOWN ISSUES
211              
212             If you have multiple iterations that typically happen very quickly, and you
213             want to limit them in a long period of time, they will "clump" together. That
214             is, they all happen at just about the same time, and then the system waits for
215             a long period before doing the same "clump" again. That's just the nature of
216             the best-fit algorithm. Anything that is done to try to separate single events
217             with longer waits than necessary will potentially create a sub-optimal
218             situation if an event in the future takes longer than expected. If you really
219             want all of your events to start at even time periods apart from each other,
220             then set the number of iterations to 1 and adjust the number of seconds
221             accordingly.
222              
223             =head1 AUTHOR
224              
225             Daniel J. Wright, Ewright@pair.comE
226              
227             =head1 SEE ALSO
228              
229             The POE module provides a more heavyweight solution to this problem as well.
230              
231             L.
232              
233             =cut