view release on metacpan or  search on metacpan

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

    token_flow => {
      my $time = time;

      $tokens += ($time - $last_check_time) * $rate;
      $tokens = $burst_size if $tokens > $burst_size;

      $last_check_time = $time;
    },
    conform => -> Num $n {
      $self<token_flow>();
      $tokens >= $n;
    },
    count => -> Num $n {
      $self<token_flow>();
      $tokens -= $n;
      $tokens = 0 if $tokens < 0;
    },
    fill => { $tokens = $burst_size },
  };

  return $self;
}

1;


=item conform(Num $n)

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.

=item count(Num $n)

This sub removes I<N> (or all if there are less than I<N> available) tokens
from the bucket.  Does not return a meaningful value.

=item fill()

Fills the bucket.

=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_bucket(rate => 2/60,    burst_size => 1);
    my $rl2 = new_bucket(rate => 20/3600, burst_size => 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) and $rl2<conform>(1)) {
        busy_wait();
      }

      $mail.take_off();
      $rl1<count>(1); $rl2<count>(1);
    }

=head1 BUGS

Documentation lacks the actual algorithm description. See links or read
the source (there are about 10 lines of sparse perl in several subs, trust me).

=head1 AUTHOR

Ingo Blechschmidt, E<lt>iblech@web.deE<gt> (port to Perl 6)

Alex Kapranoff, E<lt>kappa@rambler-co.ruE<gt>

=head1 SEE ALSO

L<http://www.eecs.harvard.edu/cs143/assignments/pa1/>,
L<http://en.wikipedia.org/wiki/Token_bucket>, 
L<http://linux-ip.net/gl/tcng/node54.html>,
L<http://linux-ip.net/gl/tcng/node62.html>,
L<Schedule::RateLimit>, L<Algorithm::FloodControl>.

=cut