File Coverage

blib/lib/Sub/Throttler/Periodic/EV.pm
Criterion Covered Total %
statement 92 102 90.2
branch 27 36 75.0
condition 5 10 50.0
subroutine 20 21 95.2
pod 8 8 100.0
total 152 177 85.8


line stmt bran cond sub pod time code
1             package Sub::Throttler::Periodic::EV;
2 2     2   434569 use 5.010001;
  2         4  
3 2     2   8 use warnings;
  2         2  
  2         39  
4 2     2   6 use strict;
  2         2  
  2         29  
5 2     2   7 use utf8;
  2         1  
  2         8  
6 2     2   27 use Carp;
  2         2  
  2         163  
7             our @CARP_NOT = qw( Sub::Throttler );
8              
9             our $VERSION = 'v0.2.10';
10              
11 2     2   8 use parent qw( Sub::Throttler::Limit );
  2         2  
  2         19  
12 2     2   102 use Sub::Throttler qw( throttle_flush );
  2         2  
  2         9  
13 2     2   136 use Time::HiRes qw( time sleep );
  2         2  
  2         14  
14 2     2   223 use Scalar::Util qw( weaken );
  2         3  
  2         68  
15 2     2   14 use EV;
  2         2  
  2         48  
16              
17              
18             sub new {
19 2     2   7 use warnings FATAL => qw( misc );
  2         2  
  2         1231  
20 35     35 1 194758 my ($class, %opt) = @_;
21             my $self = bless {
22             limit => delete $opt{limit} // 1,
23 34   100     386 period => delete $opt{period} // 1,
      100        
      33        
24             acquired=> {}, # { $id => { $key => $quantity, … }, … }
25             used => {}, # { $key => $quantity, … }
26             }, ref $class || $class;
27 34 100       270 croak 'limit must be an unsigned integer' if $self->{limit} !~ /\A\d+\z/ms;
28 32 50       72 croak 'period must be a positive number' if $self->{period} <= 0;
29 32 100       86 croak 'bad param: '.(keys %opt)[0] if keys %opt;
30 30         90 weaken(my $this = $self);
31 30 50   24   161 $self->{_t} = EV::periodic 0, $self->{period}, 0, sub { $this && $this->_tick() };
  24         1552106  
32 30         29331 $self->{_t}->keepalive(0);
33 30         93 return $self;
34             }
35              
36             sub acquire {
37 0     0 1 0 my ($self, $id, $key, $quantity) = @_;
38 0 0       0 if (!$self->try_acquire($id, $key, $quantity)) {
39 0 0 0     0 if ($quantity <= $self->{limit} && $self->{used}{$key}) {
40 0         0 my $time = time;
41 0         0 my $delay = int($time/$self->{period})*$self->{period} + $self->{period} - $time;
42 0         0 sleep $delay;
43 0         0 $self->_tick();
44             }
45 0 0       0 if (!$self->try_acquire($id, $key, $quantity)) {
46 0         0 croak "$self: unable to acquire $quantity of resource '$key'";
47             }
48             }
49 0         0 return $self;
50             }
51              
52             sub load {
53 5     5 1 84 my ($class, $state) = @_;
54 5 100       22 croak 'bad state: wrong algorithm' if $state->{algo} ne __PACKAGE__;
55 4         24 my $v = version->parse($state->{version});
56 4 100       27 if ($v > $VERSION) {
57 1         11 carp 'restoring state saved by future version';
58             }
59 4         247 my $self = $class->new(limit=>$state->{limit}, period=>$state->{period});
60             # time jump backward, no matter how much, handled like we still is in
61             # current period, to be safe
62 4 100       13 if (int($state->{at}/$self->{period})*$self->{period} + $self->{period} > time) {
63 3         23 $self->{used} = $state->{used};
64             }
65 4 100       11 if (keys %{ $self->{used} }) {
  4         10  
66 3         8 $self->{_t}->keepalive(1);
67             }
68 4         10 return $self;
69             }
70              
71             sub period {
72 8     8 1 50118 my ($self, $period) = @_;
73 8 100       27 if (1 == @_) {
74 5         32 return $self->{period};
75             }
76 3 50       23 croak 'period must be a positive number' if $period <= 0;
77 3         5 $self->{period} = $period;
78 3         16 $self->{_t}->set(0, $self->{period}, 0);
79 3         3968 return $self;
80             }
81              
82             sub release {
83 13     13 1 103908 my ($self, $id) = @_;
84 13 100       92 croak sprintf '%s not acquired anything', $id if !$self->{acquired}{$id};
85 10         27 delete $self->{acquired}{$id};
86 10         24 return $self;
87             }
88              
89             sub release_unused {
90 10     10 1 54950 my $self = shift->SUPER::release_unused(@_);
91 7 100       8 if (!keys %{ $self->{used} }) {
  7         26  
92 3         15 $self->{_t}->keepalive(0);
93             }
94 7         17 return $self;
95             }
96              
97             sub save {
98 2     2 1 3 my ($self) = @_;
99             my $state = {
100             algo => __PACKAGE__,
101             version => version->declare($VERSION)->numify,
102             limit => $self->{limit},
103             period => $self->{period},
104             used => $self->{used},
105 2         29 at => time,
106             };
107 2         28 return $state;
108             }
109              
110             sub try_acquire {
111 96     96 1 404966 my $self = shift;
112 96 100       299 if ($self->SUPER::try_acquire(@_)) {
113 54         128 $self->{_t}->keepalive(1);
114 54         143 return 1;
115             }
116 38         127 return;
117             }
118              
119             sub _tick {
120 24     24   65 my $self = shift;
121 24         46 for my $id (keys %{ $self->{acquired} }) {
  24         187  
122 22         34 for my $key (keys %{ $self->{acquired}{$id} }) {
  22         112  
123 38         111 $self->{acquired}{$id}{$key} = 0;
124             }
125             }
126             # OPTIMIZATION call throttle_flush() only if amount of available
127             # resources increased (i.e. if some sources was released)
128 24 100       46 if (keys %{ $self->{used} }) {
  24         112  
129 13         34 $self->{used} = {};
130 13         78 throttle_flush();
131             }
132 24 100       86 if (!keys %{ $self->{used} }) {
  24         120  
133 23         124 $self->{_t}->keepalive(0);
134             }
135 24         138 return;
136             }
137              
138              
139             1; # Magic true value required at end of module
140             __END__