view release on metacpan or  search on metacpan

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

	my ($self, %args) = @_;
	$self->current_allowed( $self->ticks );
	$self->last_tick( time() );
	if ($self->memcached_servers)
	{
		if ($self->{__mc_module_fast})
		{
			eval {
				my $mc = Cache::Memcached::Fast->new({ servers => $self->memcached_servers,
								       namespace => 'leaky_bucket:', });
				$self->memcached($mc);
				$self->mc_sync;
			};
			if ($@)
			{
				cluck($@);
			}
		}
		elsif ($self->{__mc_module})
		{
                        eval {
                                my $mc = Cache::Memcached->new({ servers => $self->memcached_servers,
                                                                 namespace => 'leaky_bucket:', });
                                $self->memcached($mc);
                                $self->mc_sync;
                        };
			if ($@)
			{
				cluck($@);
			}
		}
	}
	return;
}

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

	my $packed = $self->memcached->get( $self->memcached_key );
	if ($packed)
	{
		# current allowed | last tick
		my @vals = split(/\|/,$packed);
		$self->current_allowed($vals[0]);
		$self->last_tick($vals[1]);
	}
	return;
}

sub mc_write
{
	my ($self, %args) = @_;
	$self->memcached->set($self->memcached_key, $self->current_allowed . '|' . $self->last_tick);
	return;
}

=head1 BUGS

Probably some.  There is a known bug where if you are in an infinite loop you could move faster than
memcached could be updated remotely, so you'll likely at that point only bbe limted by the local 
counters.  I'm not sure how im going to fix this yet as this is in early development.

=head1 TODO

Will need to look at including some actual tests im thinking.  Maybe once we get more real usage out
of this in our produciton environment some test cases will make themselves obvious.
 
=head1 SEE ALSO

http://en.wikipedia.org/wiki/Leaky_bucket

=head1 AUTHOR

Marcus Slagle, E<lt>marc.slagle@online-rewards.comE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2012 by Marcus Slagle

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.9 or,
at your option, any later version of Perl 5 you may have available.

=cut

1;