File Coverage

blib/lib/Sub/Throttler/Periodic/EV.pm
Criterion Covered Total %
statement 93 103 90.2
branch 27 36 75.0
condition 5 10 50.0
subroutine 20 21 95.2
pod 8 8 100.0
total 153 178 85.9


line stmt bran cond sub pod time code
1             package Sub::Throttler::Periodic::EV;
2 2     2   20328 use 5.010001;
  2         5  
  2         55  
3 2     2   6 use warnings;
  2         2  
  2         34  
4 2     2   6 use strict;
  2         3  
  2         39  
5 2     2   7 use utf8;
  2         2  
  2         12  
6 2     2   38 use Carp;
  2         2  
  2         195  
7             our @CARP_NOT = qw( Sub::Throttler );
8              
9             our $VERSION = 'v0.2.2';
10              
11 2     2   551 use parent qw( Sub::Throttler::Limit );
  2         221  
  2         8  
12 2     2   107 use Sub::Throttler qw( throttle_flush );
  2         2  
  2         6  
13 2     2   630 use Time::HiRes qw( time sleep );
  2         1014  
  2         10  
14 2     2   285 use Scalar::Util qw( weaken );
  2         2  
  2         83  
15 2     2   920 use EV;
  2         3444  
  2         64  
16              
17              
18             sub new {
19 2     2   8 use warnings FATAL => qw( misc );
  2         2  
  2         1392  
20 35     35 1 198874 my ($class, %opt) = @_;
21 34   100     443 my $self = bless {
      100        
      33        
22             limit => delete $opt{limit} // 1,
23             period => delete $opt{period} // 1,
24             acquired=> {}, # { $id => { $key => $quantity, … }, … }
25             used => {}, # { $key => $quantity, … }
26             }, ref $class || $class;
27 34 100       286 croak 'limit must be an unsigned integer' if $self->{limit} !~ /\A\d+\z/ms;
28 32 50       78 croak 'period must be a positive number' if $self->{period} <= 0;
29 32 100       77 croak 'bad param: '.(keys %opt)[0] if keys %opt;
30 30         98 weaken(my $this = $self);
31 30 50   26   266 $self->{_t} = EV::periodic 0, $self->{period}, 0, sub { $this && $this->_tick() };
  26         3708846  
32 30         131 $self->{_t}->keepalive(0);
33 30         71 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 129 my ($class, $state) = @_;
54 5 100       21 croak 'bad state: wrong algorithm' if $state->{algo} ne __PACKAGE__;
55 4         38 my $v = version->parse($state->{version});
56 4 100       120 if ($v > $VERSION) {
57 1         15 carp 'restoring state saved by future version';
58             }
59 4         214 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       22 if (int($state->{at}/$self->{period})*$self->{period} + $self->{period} > time) {
63 3         4 $self->{used} = $state->{used};
64             }
65 4 100       5 if (keys %{ $self->{used} }) {
  4         10  
66 3         6 $self->{_t}->keepalive(1);
67             }
68 4         11 return $self;
69             }
70              
71             sub period {
72 8     8 1 23 my ($self, $period) = @_;
73 8 100       28 if (1 == @_) {
74 5         26 return $self->{period};
75             }
76 3 50       33 croak 'period must be a positive number' if $period <= 0;
77 3         7 $self->{period} = $period;
78 3         20 $self->{_t}->set(0, $self->{period}, 0);
79 3         12 return $self;
80             }
81              
82             sub release {
83 13     13 1 22314 my ($self, $id) = @_;
84 13 100       80 croak sprintf '%s not acquired anything', $id if !$self->{acquired}{$id};
85 10         32 delete $self->{acquired}{$id};
86 10         21 return $self;
87             }
88              
89             sub release_unused {
90 10     10 1 12057 my $self = shift->SUPER::release_unused(@_);
91 7 100       8 if (!keys %{ $self->{used} }) {
  7         20  
92 3         19 $self->{_t}->keepalive(0);
93             }
94 7         15 return $self;
95             }
96              
97             sub save {
98 2     2 1 3 my ($self) = @_;
99 2         38 my $state = {
100             algo => __PACKAGE__,
101             version => version->declare($VERSION)->numify,
102             limit => $self->{limit},
103             period => $self->{period},
104             used => $self->{used},
105             at => time,
106             };
107 2         10 return $state;
108             }
109              
110             sub try_acquire {
111 96     96 1 14437 my $self = shift;
112 96 100       296 if ($self->SUPER::try_acquire(@_)) {
113 54         154 $self->{_t}->keepalive(1);
114 54         138 return 1;
115             }
116 38         103 return;
117             }
118              
119             sub _tick {
120 26     26   91 my $self = shift;
121 26         38 for my $id (keys %{ $self->{acquired} }) {
  26         212  
122 26         37 for my $key (keys %{ $self->{acquired}{$id} }) {
  26         96  
123 42         170 $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 26 100       43 if (keys %{ $self->{used} }) {
  26         104  
129 14         35 $self->{used} = {};
130 14         70 throttle_flush();
131             }
132 26 100       94 if (!keys %{ $self->{used} }) {
  26         106  
133 25         174 $self->{_t}->keepalive(0);
134             }
135 26         2349180 return;
136             }
137              
138              
139             1; # Magic true value required at end of module
140             __END__