File Coverage

blib/lib/Sub/Throttler/Limit.pm
Criterion Covered Total %
statement 73 74 98.6
branch 24 26 92.3
condition 8 10 80.0
subroutine 17 17 100.0
pod 8 8 100.0
total 130 135 96.3


line stmt bran cond sub pod time code
1             package Sub::Throttler::Limit;
2 7     7   70188 use 5.010001;
  7         16  
  7         190  
3 7     7   27 use warnings;
  7         9  
  7         128  
4 7     7   20 use strict;
  7         8  
  7         136  
5 7     7   26 use utf8;
  7         6  
  7         37  
6 7     7   98 use Carp;
  7         7  
  7         534  
7             our @CARP_NOT = qw( Sub::Throttler );
8              
9             our $VERSION = 'v0.2.2';
10              
11 7     7   2356 use parent qw( Sub::Throttler::algo );
  7         1264  
  7         60  
12 7     7   273 use Sub::Throttler qw( throttle_flush );
  7         9  
  7         22  
13              
14              
15             sub new {
16 7     7   545 use warnings FATAL => qw( misc );
  7         8  
  7         4368  
17 104     104 1 7714 my ($class, %opt) = @_;
18 103   100     840 my $self = bless {
      33        
19             limit => delete $opt{limit} // 1,
20             acquired=> {}, # { $id => { $key => $quantity, … }, … }
21             used => {}, # { $key => $quantity, … }
22             }, ref $class || $class;
23 103 100       690 croak 'limit must be an unsigned integer' if $self->{limit} !~ /\A\d+\z/ms;
24 101 100       198 croak 'bad param: '.(keys %opt)[0] if keys %opt;
25 99         424 return $self;
26             }
27              
28             sub acquire {
29 8     8 1 7 my ($self, $id, $key, $quantity) = @_;
30 8 50       13 if (!$self->try_acquire($id, $key, $quantity)) {
31 8         96 croak "$self: unable to acquire $quantity of resource '$key'";
32             }
33 0         0 return $self;
34             }
35              
36             sub limit {
37 34     34 1 4678 my ($self, $limit) = @_;
38 34 100       82 if (1 == @_) {
39 4         17 return $self->{limit};
40             }
41 30 50       152 croak 'limit must be an unsigned integer' if $limit !~ /\A\d+\z/ms;
42             # OPTIMIZATION call throttle_flush() only if amount of available
43             # resources increased (i.e. limit was increased)
44 30         54 my $resources_increases = $self->{limit} < $limit;
45 30         41 $self->{limit} = $limit;
46 30 100       59 if ($resources_increases) {
47 14         33 throttle_flush();
48             }
49 30         51 return $self;
50             }
51              
52             sub load {
53 3     3 1 107 my ($class, $state) = @_;
54 3 100       17 croak 'bad state: wrong algorithm' if $state->{algo} ne __PACKAGE__;
55 2         17 my $v = version->parse($state->{version});
56 2 100       13 if ($v > $VERSION) {
57 1         14 carp 'restoring state saved by future version';
58             }
59 2         225 my $self = $class->new(limit=>$state->{limit});
60 2         5 return $self;
61             }
62              
63             sub release {
64 75     75 1 218 return _release(@_);
65             }
66              
67             sub release_unused {
68 47     47 1 1171 return _release(@_);
69             }
70              
71             sub save {
72 3     3 1 5 my ($self) = @_;
73 3         51 my $state = {
74             algo => __PACKAGE__,
75             version => version->declare($VERSION)->numify,
76             limit => $self->{limit},
77             used => $self->{used},
78             at => time,
79             };
80 3         10 return $state;
81             }
82              
83             sub try_acquire {
84 397     397 1 1677 my ($self, $id, $key, $quantity) = @_;
85 397 100 100     1112 croak sprintf '%s already acquired %s', $id, $key
86             if $self->{acquired}{$id} && exists $self->{acquired}{$id}{$key};
87 392 100       714 croak 'quantity must be positive' if $quantity <= 0;
88              
89 376   100     995 my $used = $self->{used}{$key} || 0;
90 376 100       715 if ($used + $quantity > $self->{limit}) {
91 165         356 return;
92             }
93 211         282 $self->{used}{$key} = $used + $quantity;
94              
95 211         359 $self->{acquired}{$id}{$key} = $quantity;
96 211         470 return 1;
97             }
98              
99             sub _release {
100 122     122   218 my ($self, $id) = @_;
101 122 100       403 croak sprintf '%s not acquired anything', $id if !$self->{acquired}{$id};
102              
103 117         102 for my $key (keys %{ $self->{acquired}{$id} }) {
  117         307  
104 131         207 my $quantity = $self->{acquired}{$id}{$key};
105 131         188 $self->{used}{$key} -= $quantity;
106             # clean up (avoid memory leak in long run with unique keys)
107 131 100       257 if (!$self->{used}{$key}) {
108 109         232 delete $self->{used}{$key};
109             }
110             }
111 117         247 delete $self->{acquired}{$id};
112 117         233 throttle_flush();
113 117         238 return $self;
114             }
115              
116              
117             1; # Magic true value required at end of module
118             __END__