view release on metacpan or  search on metacpan

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

package Algorithm::LeakyBucket;

=head1 NAME

Algorithm::LeakyBucket - Perl implementation of leaky bucket rate limiting

=head1 SYNOPSIS

 use Algorithm::LeakyBucket;
 my $bucket = Algorithm::LeakyBucket->new( ticks => 1, seconds => 1 ); # one per second

 while($something_happening)
 {
     if ($bucket->tick)
     {
         # allowed
         do_something();
	 # maybe decide to change limits?
	 $bucket->ticks(2);
	 $bucket->seconds(5);
     }
 }


=head1 CONSTRUCTOR

There are two required options to get the module to do anything useful.  C<ticks> and C<seconds> set the number of 
ticks allowed per that time period.  If C<ticks> is 3 and C<seconds> is 14, you will be able to run 3 ticks every 14 
seconds.  Optionally you can pass C<memcached_servers> and C<memcached_key> to distribute the limiting across multiple
processes.


 my $bucket = Algorithm::LeakyBucket->new( ticks => $ticks, seconds => $every_x_seconds,
                                  memcached_key => 'some_key',
                                  memcached_servers => [ { address => 'localhost:11211' } ] );

=DESCRIPTION

Implements leaky bucket as a rate limiter.  While the code will do rate limiting for a single process, it was intended
as a limiter for multiple processes. (But see the BUGS section)

The syntax of the C<memcached_servers> argument should be the syntax expected by the local memcache module.  If
Cache::Memcached::Fast is installed, use its syntax, otherwise you can use the syntax for Cache::Memcached.  If 
neither module is found it will use a locally defined set of vars internally to track rate limiting.  Obviously
this keeps the code from being used across processes. 

This is an alpha version of the code.  Some early bugs have been ironed out and its in produciton in places, so we would
probably transition it to beta once we have seen it work for a bit. 

=cut

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

sub ticks
{
	my ($self, $value) = @_;
	if (defined($value))
	{
		$self->{__ticks} = $value;
	}
	return $self->{__ticks};
}

sub seconds
{
        my ($self, $value) = @_;
        if (defined($value))
        {
                $self->{__seconds} = $value;
        }
        return $self->{__seconds};
}

sub current_allowed
{
        my ($self, $value) = @_;
        if (defined($value))
        {
                $self->{__current_allowed} = $value;
        }
        return $self->{__current_allowed};

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

sub tick
{
	my ($self, %args ) = @_;

	if ($self->memcached)
	{
		# init form mc 
		$self->mc_sync;
	}
	
	# seconds since last tick
	my $now = time();
	my $seconds_passed = $now - $self->last_tick;
	$self->last_tick( time() );

	# add tokens to bucket
	my $current_ticks_allowed = $self->current_allowed + ( $seconds_passed * ( $self->ticks / $self->seconds ));
	$self->current_allowed( $current_ticks_allowed );

	if ($current_ticks_allowed > $self->ticks)
	{
		$self->current_allowed($self->ticks);
		if ($self->memcached)
		{
			$self->mc_write;
		}
		return 1;