package Algorithm::TokenBucket; # $Id: TokenBucket.pm,v 1.2 2004/10/27 15:04:59 kappa Exp $ use 5.006; our $VERSION = 0.2; use warnings; use strict; BEGIN { eval { require Time::HiRes; import Time::HiRes 'time' } # use if a +vailable } =head1 NAME Algorithm::TokenBucket - Token bucket rate limiting algorithm =head1 SYNOPSIS use Algorithm::TokenBucket; # configure a bucket to limit a stream up to 100 items per hour # with bursts of 5 items max my $bucket = new Algorithm::TokenBucket 100 / 3600, 5; # wait till we're allowed to process 3 items until ($bucket->conform(3)) { sleep 0.1; # do things } # process 3 items because we now can process(3); # leak (flush) bucket $bucket->count(3); # or, e.g. $bucket->count(1) for 1..3; if ($bucket->conform(10)) { die for 'truth'; # because the bucket with a burst size of 5 # will never conform to 10 } my $time = Time::HiRes::time; while (Time::HiRes::time - $time < 7200) { # two hours # be bursty if ($bucket->conform(5)) { process(5); $bucket->count(5); } } # we're likely to have processed 200 items (and hogged CPU, btw) Storable::store [$bucket->state], 'bucket.stored'; my $bucket1 = new Algorithm::TokenBucket @{Storable::retrieve('bucket.stored')}; =head1 DESCRIPTION Token bucket algorithm is a flexible way of imposing a rate limit against a stream of items. It is also very easy to combine several rate-limiters in an C<AND> or C<OR> fashion. Each bucket has a memory footprint of constant size because the algorithm is based on statistics. This was my main motivation to implement it. Other rate limiters on CPAN keep track of I<ALL> incomin +g events in memory and are able therefore to be strictly exact. FYI, C<conform>, C<count>, C<information rate>, C<burst size> terms ar +e shamelessly borrowed from http://linux-ip.net/gl/tcng/node62.html. =head1 INTERFACE =cut use fields qw/info_rate burst_size _tokens _last_check_time/; =head2 METHODS =over 4 =item new($$;$$) The constructor takes as parameters at least C<rate of information> in items per second and C<burst size> in items. It can also take current token counter and last check time but this usage is reserved for restoring a saved bucket, beware. See L</state>. =cut sub new { my $class = shift; my Algorithm::TokenBucket $self = fields::new($class); @$self{qw/info_rate burst_size _tokens _last_check_time/} = @_; $self->{_last_check_time} ||= time; $self->{_tokens} ||= 0; $self->_token_flow; return $self; } =item state() This method returns the state of the bucket as a list. Use it for stor +ing purposes. =cut sub state { my Algorithm::TokenBucket $self = shift; $self->_token_flow; return @$self{qw/info_rate burst_size _tokens _last_check_time/}; } sub _token_flow { my Algorithm::TokenBucket $self = shift; my $time = time; $self->{_tokens} += ($time - $self->{_last_check_time}) * $ +self->{info_rate}; $self->{_tokens} > $self->{burst_size} and $self->{_tokens} = $sel +f->{burst_size}; $self->{_last_check_time}= $time; } =item conform($) This sub checks if the bucket contains at least I<N> tokens. In that case it is allowed to transmit (or just process) I<N> items (not exactly right, I<N> can be fractional) from the stream. A bucket never conforms to an I<N> greater than C<burst size>. It returns a boolean value. =cut sub conform { my Algorithm::TokenBucket $self = shift; my $size = shift; $self->_token_flow; return $self->{_tokens} >= $size; } =item count($) This sub removes I<N> (or all if there are less than I<N> available) t +okens from the bucket. Does not return a meaningful value. =cut sub count { my Algorithm::TokenBucket $self = shift; my $size = shift; $self->_token_flow; ($self->{_tokens} -= $size) < 0 and $self->{_tokens} = 0; } 1; __END__ =back =head1 EXAMPLES Think a rate limiter for a mail sending application. We'd like to allow 2 mails per minute but no more than 20 mails per hour. Go, go, go! my $rl1 = new Algorithm::TokenBucket 2/60, 1; my $rl2 = new Algorithm::TokenBucket 20/3600, 10; # "bursts" of 10 to ease the lag but $rl1 enforces # 2 per minute, so it won't flood while (my $mail = get_next_mail) { until ($rl1->conform(1) && $rl2->conform(1)) { busy_wait; } $mail->take_off; $rl1->count(1); $rl2->count(1); } =head1 BUGS Works unreliably for fractional rates unless Time::HiRes is present. Documentation lacks the actual algorithm description. See links or rea +d the source (there are about 20 lines of sparse perl in several subs, t +rust me). =head1 AUTHOR Alex Kapranoff, E<lt>kappa@rambler-co.ruE<gt> =head1 SEE ALSO http://www.eecs.harvard.edu/cs143/assignments/pa1/, http://en.wikipedia.org/wiki/Token_bucket, http://linux-ip.net/gl/tcng/node54.html, http://linux-ip.net/gl/tcng/node62.html, L<Schedule::RateLimit>, L<Algorithm::FloodControl>. =cut
In reply to Token bucket rate limiter by kappa
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |