File Coverage

blib/lib/Sub/Throttler/Limit.pm

Criterion	Covered	Total	%
statement	72	73	98.6
branch	24	26	92.3
condition	7	10	70.0
subroutine	17	17	100.0
pod	8	8	100.0
total	128	134	95.5

package Sub::Throttler::Limit;
use 5.010001;
use warnings;
use strict;
use utf8;
use Carp;
our @CARP_NOT = qw( Sub::Throttler Sub::Throttler::Periodic::EV );

our $VERSION = 'v0.2.10';

use parent qw( Sub::Throttler::algo );
use Sub::Throttler qw( throttle_flush );


sub new {
    use warnings FATAL => qw( misc );
    my ($class, %opt) = @_;
    my $self = bless {
        limit   => delete $opt{limit} // 1,
        acquired=> {},  # { $id => { $key => $quantity, … }, … }
        used    => {},  # { $key => $quantity, … }
        }, ref $class || $class;
    croak 'limit must be an unsigned integer' if $self->{limit} !~ /\A\d+\z/ms;
    croak 'bad param: '.(keys %opt)[0] if keys %opt;
    return $self;
}

sub acquire {
    my ($self, $id, $key, $quantity) = @_;
    if (!$self->try_acquire($id, $key, $quantity)) {
        croak "$self: unable to acquire $quantity of resource '$key'";
    }
    return $self;
}

sub limit {
    my ($self, $limit) = @_;
    if (1 == @_) {
        return $self->{limit};
    }
    croak 'limit must be an unsigned integer' if $limit !~ /\A\d+\z/ms;
    # OPTIMIZATION call throttle_flush() only if amount of available
    # resources increased (i.e. limit was increased)
    my $resources_increases = $self->{limit} < $limit;
    $self->{limit} = $limit;
    if ($resources_increases) {
        throttle_flush();
    }
    return $self;
}

sub load {
    my ($class, $state) = @_;
    croak 'bad state: wrong algorithm' if $state->{algo} ne __PACKAGE__;
    my $v = version->parse($state->{version});
    if ($v > $VERSION) {
        carp 'restoring state saved by future version';
    }
    my $self = $class->new(limit=>$state->{limit});
    return $self;
}

sub release {
    return _release(@_);
}

sub release_unused {
    return _release(@_);
}

sub save {
    my ($self) = @_;
    my $state = {
        algo    => __PACKAGE__,
        version => version->declare($VERSION)->numify,
        limit   => $self->{limit},
        used    => $self->{used},
        at      => time,
    };
    return $state;
}

sub try_acquire {
    my ($self, $id, $key, $quantity) = @_;
    croak sprintf '%s already acquired %s', $id, $key
        if $self->{acquired}{$id} && exists $self->{acquired}{$id}{$key};
    croak 'quantity must be positive' if $quantity <= 0;

    my $used = $self->{used}{$key} || 0;
    if ($used + $quantity > $self->{limit}) {
        return;
    }
    $self->{used}{$key} = $used + $quantity;

    $self->{acquired}{$id}{$key} = $quantity;
    return 1;
}

sub _release {
    my ($self, $id) = @_;
    croak sprintf '%s not acquired anything', $id if !$self->{acquired}{$id};

    for my $key (keys %{ $self->{acquired}{$id} }) {
        my $quantity = $self->{acquired}{$id}{$key};
        $self->{used}{$key} -= $quantity;
        # clean up (avoid memory leak in long run with unique keys)
        if (!$self->{used}{$key}) {
            delete $self->{used}{$key};
        }
    }
    delete $self->{acquired}{$id};
    throttle_flush();
    return $self;
}


1; # Magic true value required at end of module
__END__