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   90729 use 5.010001;
  7         19  
  7         224  
3 7     7   33 use warnings;
  7         7  
  7         153  
4 7     7   27 use strict;
  7         7  
  7         182  
5 7     7   34 use utf8;
  7         9  
  7         43  
6 7     7   157 use Carp;
  7         10  
  7         644  
7             our @CARP_NOT = qw( Sub::Throttler );
8              
9             our $VERSION = 'v0.2.3';
10              
11 7     7   2608 use parent qw( Sub::Throttler::algo );
  7         1384  
  7         68  
12 7     7   285 use Sub::Throttler qw( throttle_flush );
  7         10  
  7         22  
13              
14              
15             sub new {
16 7     7   494 use warnings FATAL => qw( misc );
  7         8  
  7         3826  
17 104     104 1 7857 my ($class, %opt) = @_;
18 103   100     975 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       699 croak 'limit must be an unsigned integer' if $self->{limit} !~ /\A\d+\z/ms;
24 101 100       237 croak 'bad param: '.(keys %opt)[0] if keys %opt;
25 99         459 return $self;
26             }
27              
28             sub acquire {
29 8     8 1 11 my ($self, $id, $key, $quantity) = @_;
30 8 50       15 if (!$self->try_acquire($id, $key, $quantity)) {
31 8         126 croak "$self: unable to acquire $quantity of resource '$key'";
32             }
33 0         0 return $self;
34             }
35              
36             sub limit {
37 34     34 1 4937 my ($self, $limit) = @_;
38 34 100       85 if (1 == @_) {
39 4         18 return $self->{limit};
40             }
41 30 50       159 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         56 my $resources_increases = $self->{limit} < $limit;
45 30         36 $self->{limit} = $limit;
46 30 100       57 if ($resources_increases) {
47 14         39 throttle_flush();
48             }
49 30         66 return $self;
50             }
51              
52             sub load {
53 3     3 1 121 my ($class, $state) = @_;
54 3 100       18 croak 'bad state: wrong algorithm' if $state->{algo} ne __PACKAGE__;
55 2         18 my $v = version->parse($state->{version});
56 2 100       15 if ($v > $VERSION) {
57 1         15 carp 'restoring state saved by future version';
58             }
59 2         210 my $self = $class->new(limit=>$state->{limit});
60 2         7 return $self;
61             }
62              
63             sub release {
64 75     75 1 238 return _release(@_);
65             }
66              
67             sub release_unused {
68 46     46 1 1320 return _release(@_);
69             }
70              
71             sub save {
72 3     3 1 5 my ($self) = @_;
73 3         63 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         13 return $state;
81             }
82              
83             sub try_acquire {
84 396     396 1 1842 my ($self, $id, $key, $quantity) = @_;
85 396 100 100     1217 croak sprintf '%s already acquired %s', $id, $key
86             if $self->{acquired}{$id} && exists $self->{acquired}{$id}{$key};
87 391 100       811 croak 'quantity must be positive' if $quantity <= 0;
88              
89 375   100     1037 my $used = $self->{used}{$key} || 0;
90 375 100       715 if ($used + $quantity > $self->{limit}) {
91 165         426 return;
92             }
93 210         315 $self->{used}{$key} = $used + $quantity;
94              
95 210         417 $self->{acquired}{$id}{$key} = $quantity;
96 210         551 return 1;
97             }
98              
99             sub _release {
100 121     121   344 my ($self, $id) = @_;
101 121 100       395 croak sprintf '%s not acquired anything', $id if !$self->{acquired}{$id};
102              
103 116         104 for my $key (keys %{ $self->{acquired}{$id} }) {
  116         370  
104 129         217 my $quantity = $self->{acquired}{$id}{$key};
105 129         188 $self->{used}{$key} -= $quantity;
106             # clean up (avoid memory leak in long run with unique keys)
107 129 100       258 if (!$self->{used}{$key}) {
108 108         269 delete $self->{used}{$key};
109             }
110             }
111 116         275 delete $self->{acquired}{$id};
112 116         275 throttle_flush();
113 116         352 return $self;
114             }
115              
116              
117             1; # Magic true value required at end of module
118             __END__