File Coverage

blib/lib/Starch/Plugin/ThrottleStore.pm
Criterion Covered Total %
statement 17 17 100.0
branch n/a
condition n/a
subroutine 6 6 100.0
pod n/a
total 23 23 100.0


line stmt bran cond sub pod time code
1             package Starch::Plugin::ThrottleStore;
2 1     1   536 use 5.008001;
  1         4  
3 1     1   7 use strictures 2;
  1         9  
  1         43  
4             our $VERSION = '0.11';
5              
6             =head1 NAME
7              
8             Starch::Plugin::ThrottleStore - Throttle misbehaving Starch stores.
9              
10             =head1 SYNOPSIS
11              
12             my $starch = Starch->new(
13             plugins => ['::ThrottleStore'],
14             store => {
15             class => ...,
16             throttle_threshold => 2,
17             throttle_duration => 20,
18             },
19             );
20              
21             =head1 DESCRIPTION
22              
23             This plugin detects stores which are throwing errors consistently
24             and disables them for a period of time.
25              
26             When the L number of consecutive errors
27             is reached all store operations will be disabled for
28             L seconds.
29              
30             When the error threshold has been reached an erorr log message
31             will be produced stating that throttling is starting. Each
32             store access for the duration of the throttling will then produce
33             a log message stating which state key is being throttled.
34              
35             =cut
36              
37 1     1   250 use Types::Common::Numeric -types;
  1         2  
  1         20  
38 1     1   1602 use Try::Tiny;
  1         2  
  1         64  
39              
40 1     1   6 use Moo::Role;
  1         2  
  1         10  
41 1     1   421 use namespace::clean;
  1         3  
  1         9  
42              
43             with qw(
44             Starch::Plugin::ForStore
45             );
46              
47             =head1 OPTIONAL STORE ARGUMENTS
48              
49             These arguments are added to classes which consume the
50             L role.
51              
52             =head2 throttle_threshold
53              
54             How many consecutive errors which will trigger throttling.
55             Defaults to C<1>, which means the first error detected will
56             begin throttling.
57              
58             =cut
59              
60             has throttle_threshold => (
61             is => 'ro',
62             isa => PositiveInt,
63             default => 1,
64             );
65              
66             =head2 throttle_duration
67              
68             How many seconds to throttle for once the L
69             has been reached. Default to C<60> (1 minute).
70              
71             =cut
72              
73             has throttle_duration => (
74             is => 'ro',
75             isa => PositiveInt,
76             default => 60,
77             );
78              
79             =head1 STORE ATTRIBUTES
80              
81             These attributes are added to classes which consume the
82             L role.
83              
84             =head2 throttle_error_count
85              
86             Contains the current number of consecutive errors.
87              
88             =cut
89              
90             has throttle_error_count => (
91             is => 'ro',
92             init_Arg => undef,
93             default => 0,
94             writer => '_set_throttle_error_count',
95             );
96              
97             =head2 throttle_start
98              
99             Contains the epoch time of when the L was
100             passed and throttling began.
101              
102             =cut
103              
104             has throttle_start => (
105             is => 'ro',
106             init_arg => undef,
107             writer => '_set_throttle_start',
108             clearer => '_clear_throttle_start',
109             );
110              
111             foreach my $method (qw( set get remove )) {
112             around $method => sub{
113             my $orig = shift;
114             my $self = shift;
115              
116             my $error_count = $self->throttle_error_count();
117             my $start = $self->throttle_start();
118              
119             if ($start) {
120             my $duration = $self->throttle_duration();
121             if ($start + $duration < time()) {
122             $self->_clear_throttle_start();
123             $error_count = 0;
124             }
125             else {
126             my ($id, $namespace) = @_;
127             my $manager = $self->manager();
128             my $key = $self->stringify_key( $id, $namespace );
129             $self->log->errorf(
130             'Throttling %s of state key %s on the %s store for the next %d seconds.',
131             $method, $key, $self->short_store_class_name(), ($start + $duration) - time(),
132             );
133             return {
134             $manager->no_store_state_key() => 1,
135             } if $method eq 'get';
136             return;
137             }
138             }
139              
140             my @args = @_;
141             my ($ret, $error, $errored);
142             try { $ret = $self->$orig( @args ) }
143             catch { $error=$_; $errored=1 };
144              
145             if ($errored) { $error_count ++ }
146             else { $error_count = 0 }
147             $self->_set_throttle_error_count( $error_count );
148              
149             my $threshold = $self->throttle_threshold();
150             if ($error_count >= $threshold) {
151             $self->log->errorf(
152             'Error threshold %d reached on the %s store, throttling for the next %d seconds.',
153             $threshold, $self->short_store_class_name(), $self->throttle_duration(),
154             );
155             $self->_set_throttle_start( time() );
156             }
157              
158             die $error if $errored;
159              
160             return $ret if $method eq 'get';
161             return;
162             };
163             }
164              
165             1;
166             __END__