As noted in my other comment, I'm scrapping this first implementation because it quickly becomes too slow when the number of keys/hits reaches thousands. I'm now using the "buckets" approach like done in Data::Throttler. And my module is now consistently an order of magnitude slower than Data::Throttler for various values of max_items.

package Data::Throttler_CHI;

use strict;
use warnings;

use List::Util qw(sum);

sub new {
    my ($class, %args) = @_;

    defined $args{max_items} or die "new: Please specify max_items";
    $args{max_items} >= 1    or die "new: max_items must be at least 1
+";
    defined $args{interval}  or die "new: Please specify interval";
    $args{interval} >= 1     or die "new: interval must be at least 1"
+;
    defined $args{cache}     or die "new: Please specify cache";

    # calculate nof_buckets
    my $nof_buckets;
    if (defined $args{nof_buckets}) {
        $args{nof_buckets} >= 1 or die "new: nof_buckets must be at le
+ast 1";
        $nof_buckets = $args{nof_buckets};
    } else {
        $nof_buckets = $args{interval} ** 0.5;
    }
    $nof_buckets = int($nof_buckets);

    my $self = {
        t0              => time(),
        max_items       => $args{max_items},
        interval        => $args{interval},
        cache           => $args{cache},
        nof_buckets     => $nof_buckets,
        secs_per_bucket => $args{interval} / $nof_buckets,
    };
    bless $self, $class;
}

sub try_push {
    my $self = shift;

    my $now = time();

    my $secs_after_latest_interval = ($now - $self->{t0}) % $self->{in
+terval};
    my $bucket_num = int(
        $secs_after_latest_interval / $self->{interval} * $self->{nof_
+buckets}
    ) + 1; # 1 .. nof_buckets

    my $hits = $self->{cache}->get("hits.$bucket_num");

    my $all_hits = $self->{cache}->get_multi_arrayref(
        [map {"hits.$_"} 1..$self->{nof_buckets}]);
    my $total_hits = sum(grep {defined} @$all_hits) || 0;

    return 0 if $total_hits >= $self->{max_items};

    if ($hits) {
        $self->{cache}->set(
            "hits.$bucket_num", $hits+1,
            {expires_at=>$self->{cache}->get_expires_at("hits.$bucket_
+num")});
    } else {
        $self->{cache}->set(
            "hits.$bucket_num", 1,
            {expires_at => $now + $self->{interval} - $secs_after_late
+st_interval + ($bucket_num-1) * $self->{secs_per_bucket}});
    }

    1;
}

1;
[download]

Once again, the more complete version resides on CPAN.

---

---

• Are you posting in the right place? Check out Where do I post X? to know for sure.
• Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:

  <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>

• Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
• Want more info? How to link or How to display code and escape characters are good places to start.