view release on metacpan or  search on metacpan

lib/Algorithm/TokenBucket.pm  view on Meta::CPAN

our $VERSION = 0.38;

use Time::HiRes qw/time/;

=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 = Algorithm::TokenBucket->new(100 / 3600, 5);

    # wait until we are 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);  # same as $bucket->count(1) for 1..3;

    if ($bucket->conform(10)) {
        die;
        # because a bucket with the 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)

    Storable::store $bucket, 'bucket.stored';
    my $bucket1 =
        Algorithm::TokenBucket->new(@{Storable::retrieve('bucket.stored')});

=head1 DESCRIPTION

The 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 constant memory footprint because the algorithm is based
on the C<information rate>. Other rate limiters may keep track of
I<ALL> incoming items in memory. It allows them to be more accurate.

FYI, the C<conform>, C<count>, C<information rate>, and C<burst size> terms
are taken from the L<metering primitives|http://linux-ip.net/gl/tcng/node62.html>
page of the L<Linux Traffic Control - Next Generation|http://linux-ip.net/gl/tcng/>
system documentation.

=head1 INTERFACE

=cut

use fields qw/info_rate burst_size _tokens _last_check_time/;

=head2 METHODS

=over 4

=item new($$;$$)

The constructor requires at least the C<rate of information> in items per
second and the C<burst size> in items as its input parameters. It can also
take the current token counter and last check time but this usage is mostly
intended for restoring a saved bucket. See L</state()>.

=cut

sub new {
    my $class   = shift;
    fields::new($class)->_init(@_);
}

sub _init {
    my Algorithm::TokenBucket $self = shift;

    @$self{qw/info_rate burst_size _tokens _last_check_time/} = @_;
    $self->{_last_check_time} ||= time;
    $self->{_tokens} ||= 0;

    return $self;
}

=item state()

Returns the state of the bucket as a list. Use it for storing purposes.
Buckets also natively support freezing and thawing with L<Storable> by
providing C<STORABLE_*> callbacks.

=cut

sub state {
    my Algorithm::TokenBucket $self = shift;

    return @$self{qw/info_rate burst_size _tokens _last_check_time/};
}

use constant PACK_FORMAT => "d4";   # "F4" is not 5.6 compatible

sub STORABLE_freeze {
    my ($self, $cloning) = @_;
    return pack(PACK_FORMAT(), $self->state);
}

sub STORABLE_thaw {
    my ($self, $cloning, $state) = @_;
    return $self->_init(unpack(PACK_FORMAT(), $state));