| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package Algorithm::Backoff; | 
| 2 |  |  |  |  |  |  |  | 
| 3 |  |  |  |  |  |  | our $DATE = '2019-06-18'; # DATE | 
| 4 |  |  |  |  |  |  | our $VERSION = '0.007'; # VERSION | 
| 5 |  |  |  |  |  |  |  | 
| 6 | 8 |  |  | 8 |  | 2895 | use 5.010001; | 
|  | 8 |  |  |  |  | 25 |  | 
| 7 | 8 |  |  | 8 |  | 35 | use strict 'subs', 'vars'; | 
|  | 8 |  |  |  |  | 10 |  | 
|  | 8 |  |  |  |  | 166 |  | 
| 8 | 8 |  |  | 8 |  | 32 | use warnings; | 
|  | 8 |  |  |  |  | 18 |  | 
|  | 8 |  |  |  |  | 189 |  | 
| 9 |  |  |  |  |  |  |  | 
| 10 | 8 |  |  | 8 |  | 3255 | use Time::HiRes qw(time); | 
|  | 8 |  |  |  |  | 8977 |  | 
|  | 8 |  |  |  |  | 27 |  | 
| 11 |  |  |  |  |  |  |  | 
| 12 |  |  |  |  |  |  | our %SPEC; | 
| 13 |  |  |  |  |  |  |  | 
| 14 |  |  |  |  |  |  | our %attr_consider_actual_delay = ( | 
| 15 |  |  |  |  |  |  | consider_actual_delay => { | 
| 16 |  |  |  |  |  |  | summary => 'Whether to consider actual delay', | 
| 17 |  |  |  |  |  |  | schema => ['bool*'], | 
| 18 |  |  |  |  |  |  | default => 0, | 
| 19 |  |  |  |  |  |  | tags => ['common'], | 
| 20 |  |  |  |  |  |  | description => <<'_', | 
| 21 |  |  |  |  |  |  |  | 
| 22 |  |  |  |  |  |  | If set to true, will take into account the actual delay (timestamp difference). | 
| 23 |  |  |  |  |  |  | For example, when using the Constant strategy of delay=2, you log failure() | 
| 24 |  |  |  |  |  |  | again right after the previous failure() (i.e. specify the same timestamp). | 
| 25 |  |  |  |  |  |  | failure() will then return ~2+2 = 4 seconds. On the other hand, if you waited 2 | 
| 26 |  |  |  |  |  |  | seconds before calling failure() again (i.e. specify the timestamp that is 2 | 
| 27 |  |  |  |  |  |  | seconds larger than the previous timestamp), failure() will return 2 seconds. | 
| 28 |  |  |  |  |  |  | And if you waited 4 seconds or more, failure() will return 0. | 
| 29 |  |  |  |  |  |  |  | 
| 30 |  |  |  |  |  |  | _ | 
| 31 |  |  |  |  |  |  | }, | 
| 32 |  |  |  |  |  |  | ); | 
| 33 |  |  |  |  |  |  |  | 
| 34 |  |  |  |  |  |  | our %attr_max_actual_duration = ( | 
| 35 |  |  |  |  |  |  | max_actual_duration => { | 
| 36 |  |  |  |  |  |  | summary => 'Maximum number of seconds for all of the attempts (0 means unlimited)', | 
| 37 |  |  |  |  |  |  | schema => ['ufloat*'], | 
| 38 |  |  |  |  |  |  | default => 0, | 
| 39 |  |  |  |  |  |  | tags => ['common'], | 
| 40 |  |  |  |  |  |  | description => <<'_', | 
| 41 |  |  |  |  |  |  |  | 
| 42 |  |  |  |  |  |  | If set to a positive number, will limit the number of seconds for all of the | 
| 43 |  |  |  |  |  |  | attempts. This setting is used to limit the amount of time you are willing to | 
| 44 |  |  |  |  |  |  | spend on a task. For example, when using the Exponential strategy of | 
| 45 |  |  |  |  |  |  | initial_delay=3 and max_attempts=10, the delays will be 3, 6, 12, 24, ... If | 
| 46 |  |  |  |  |  |  | failures are logged according to the suggested delays, and max_actual_duration | 
| 47 |  |  |  |  |  |  | is set to 21 seconds, then the third failure() will return -1 instead of 24 | 
| 48 |  |  |  |  |  |  | because 3+6+12 >= 21, even though max_attempts has not been exceeded. | 
| 49 |  |  |  |  |  |  |  | 
| 50 |  |  |  |  |  |  | _ | 
| 51 |  |  |  |  |  |  | }, | 
| 52 |  |  |  |  |  |  | ); | 
| 53 |  |  |  |  |  |  |  | 
| 54 |  |  |  |  |  |  | our %attr_max_attempts = ( | 
| 55 |  |  |  |  |  |  | max_attempts => { | 
| 56 |  |  |  |  |  |  | summary => 'Maximum number consecutive failures before giving up', | 
| 57 |  |  |  |  |  |  | schema => 'uint*', | 
| 58 |  |  |  |  |  |  | default => 0, | 
| 59 |  |  |  |  |  |  | tags => ['common'], | 
| 60 |  |  |  |  |  |  | description => <<'_', | 
| 61 |  |  |  |  |  |  |  | 
| 62 |  |  |  |  |  |  | 0 means to retry endlessly without ever giving up. 1 means to give up after a | 
| 63 |  |  |  |  |  |  | single failure (i.e. no retry attempts). 2 means to retry once after a failure. | 
| 64 |  |  |  |  |  |  | Note that after a success, the number of attempts is reset (as expected). So if | 
| 65 |  |  |  |  |  |  | max_attempts is 3, and if you fail twice then succeed, then on the next failure | 
| 66 |  |  |  |  |  |  | the algorithm will retry again for a maximum of 3 times. | 
| 67 |  |  |  |  |  |  |  | 
| 68 |  |  |  |  |  |  | _ | 
| 69 |  |  |  |  |  |  | }, | 
| 70 |  |  |  |  |  |  | ); | 
| 71 |  |  |  |  |  |  |  | 
| 72 |  |  |  |  |  |  | our %attr_jitter_factor = ( | 
| 73 |  |  |  |  |  |  | jitter_factor => { | 
| 74 |  |  |  |  |  |  | summary => 'How much to add randomness', | 
| 75 |  |  |  |  |  |  | schema => ['float*', between=>[0, 0.5]], | 
| 76 |  |  |  |  |  |  | tags => ['common'], | 
| 77 |  |  |  |  |  |  | description => <<'_', | 
| 78 |  |  |  |  |  |  |  | 
| 79 |  |  |  |  |  |  | If you set this to a value larger than 0, the actual delay will be between a | 
| 80 |  |  |  |  |  |  | random number between original_delay * (1-jitter_factor) and original_delay * | 
| 81 |  |  |  |  |  |  | (1+jitter_factor). Jitters are usually added to avoid so-called "thundering | 
| 82 |  |  |  |  |  |  | herd" problem. | 
| 83 |  |  |  |  |  |  |  | 
| 84 |  |  |  |  |  |  | The jitter will be applied to delay on failure as well as on success. | 
| 85 |  |  |  |  |  |  |  | 
| 86 |  |  |  |  |  |  | _ | 
| 87 |  |  |  |  |  |  | }, | 
| 88 |  |  |  |  |  |  | ); | 
| 89 |  |  |  |  |  |  |  | 
| 90 |  |  |  |  |  |  | our %attr_delay_on_success = ( | 
| 91 |  |  |  |  |  |  | delay_on_success => { | 
| 92 |  |  |  |  |  |  | summary => 'Number of seconds to wait after a success', | 
| 93 |  |  |  |  |  |  | schema => 'ufloat*', | 
| 94 |  |  |  |  |  |  | default => 0, | 
| 95 |  |  |  |  |  |  | }, | 
| 96 |  |  |  |  |  |  | ); | 
| 97 |  |  |  |  |  |  |  | 
| 98 |  |  |  |  |  |  | our %attr_max_delay = ( | 
| 99 |  |  |  |  |  |  | max_delay => { | 
| 100 |  |  |  |  |  |  | summary => 'Maximum delay time, in seconds', | 
| 101 |  |  |  |  |  |  | schema => 'ufloat*', | 
| 102 |  |  |  |  |  |  | tags => ['common'], | 
| 103 |  |  |  |  |  |  | }, | 
| 104 |  |  |  |  |  |  | ); | 
| 105 |  |  |  |  |  |  |  | 
| 106 |  |  |  |  |  |  | our %attr_min_delay = ( | 
| 107 |  |  |  |  |  |  | min_delay => { | 
| 108 |  |  |  |  |  |  | summary => 'Maximum delay time, in seconds', | 
| 109 |  |  |  |  |  |  | schema => 'ufloat*', | 
| 110 |  |  |  |  |  |  | default => 0, | 
| 111 |  |  |  |  |  |  | tags => ['common'], | 
| 112 |  |  |  |  |  |  | }, | 
| 113 |  |  |  |  |  |  | ); | 
| 114 |  |  |  |  |  |  |  | 
| 115 |  |  |  |  |  |  | our %attr_initial_delay = ( | 
| 116 |  |  |  |  |  |  | initial_delay => { | 
| 117 |  |  |  |  |  |  | summary => 'Initial delay for the first attempt after failure, '. | 
| 118 |  |  |  |  |  |  | 'in seconds', | 
| 119 |  |  |  |  |  |  | schema => 'ufloat*', | 
| 120 |  |  |  |  |  |  | req => 1, | 
| 121 |  |  |  |  |  |  | }, | 
| 122 |  |  |  |  |  |  | ); | 
| 123 |  |  |  |  |  |  |  | 
| 124 |  |  |  |  |  |  | our %attr_delay_multiple_on_failure = ( | 
| 125 |  |  |  |  |  |  | delay_multiple_on_failure => { | 
| 126 |  |  |  |  |  |  | summary => 'How much to multiple previous delay, upon failure (e.g. 1.5)', | 
| 127 |  |  |  |  |  |  | schema => 'ufloat*', | 
| 128 |  |  |  |  |  |  | req => 1, | 
| 129 |  |  |  |  |  |  | }, | 
| 130 |  |  |  |  |  |  | ); | 
| 131 |  |  |  |  |  |  |  | 
| 132 |  |  |  |  |  |  | our %attr_delay_multiple_on_success = ( | 
| 133 |  |  |  |  |  |  | delay_multiple_on_success => { | 
| 134 |  |  |  |  |  |  | summary => 'How much to multiple previous delay, upon success (e.g. 0.5)', | 
| 135 |  |  |  |  |  |  | schema => 'ufloat*', | 
| 136 |  |  |  |  |  |  | req => 1, | 
| 137 |  |  |  |  |  |  | }, | 
| 138 |  |  |  |  |  |  | ); | 
| 139 |  |  |  |  |  |  |  | 
| 140 |  |  |  |  |  |  | our %attr_delay_increment_on_failure = ( | 
| 141 |  |  |  |  |  |  | delay_increment_on_failure => { | 
| 142 |  |  |  |  |  |  | summary => 'How much to add to previous delay, in seconds, upon failure (e.g. 5)', | 
| 143 |  |  |  |  |  |  | schema => 'float*', | 
| 144 |  |  |  |  |  |  | req => 1, | 
| 145 |  |  |  |  |  |  | }, | 
| 146 |  |  |  |  |  |  | ); | 
| 147 |  |  |  |  |  |  |  | 
| 148 |  |  |  |  |  |  | our %attr_delay_increment_on_success = ( | 
| 149 |  |  |  |  |  |  | delay_increment_on_success => { | 
| 150 |  |  |  |  |  |  | summary => 'How much to add to previous delay, in seconds, upon success (e.g. -5)', | 
| 151 |  |  |  |  |  |  | schema => 'float*', | 
| 152 |  |  |  |  |  |  | req => 1, | 
| 153 |  |  |  |  |  |  | }, | 
| 154 |  |  |  |  |  |  | ); | 
| 155 |  |  |  |  |  |  |  | 
| 156 |  |  |  |  |  |  | $SPEC{new} = { | 
| 157 |  |  |  |  |  |  | v => 1.1, | 
| 158 |  |  |  |  |  |  | is_class_meth => 1, | 
| 159 |  |  |  |  |  |  | is_func => 0, | 
| 160 |  |  |  |  |  |  | args => { | 
| 161 |  |  |  |  |  |  | %attr_max_attempts, | 
| 162 |  |  |  |  |  |  | %attr_jitter_factor, | 
| 163 |  |  |  |  |  |  | }, | 
| 164 |  |  |  |  |  |  | result_naked => 1, | 
| 165 |  |  |  |  |  |  | result => { | 
| 166 |  |  |  |  |  |  | schema => 'obj*', | 
| 167 |  |  |  |  |  |  | }, | 
| 168 |  |  |  |  |  |  | }; | 
| 169 |  |  |  |  |  |  | sub new { | 
| 170 | 18 |  |  | 18 | 1 | 19868 | my ($class, %args) = @_; | 
| 171 |  |  |  |  |  |  |  | 
| 172 | 18 |  |  |  |  | 27 | my $attrspec = ${"$class\::SPEC"}{new}{args}; | 
|  | 18 |  |  |  |  | 69 |  | 
| 173 |  |  |  |  |  |  |  | 
| 174 |  |  |  |  |  |  | # check known attributes | 
| 175 | 18 |  |  |  |  | 55 | for my $arg (keys %args) { | 
| 176 | 56 | 100 |  |  |  | 112 | $arg =~ /\A(_start_timestamp)\z/ and next; | 
| 177 | 55 | 50 |  |  |  | 115 | $attrspec->{$arg} or die "$class: Unknown attribute '$arg'"; | 
| 178 |  |  |  |  |  |  | } | 
| 179 |  |  |  |  |  |  | # check required attributes and set default | 
| 180 | 18 |  |  |  |  | 61 | for my $attr (keys %$attrspec) { | 
| 181 | 151 | 100 |  |  |  | 258 | if ($attrspec->{$attr}{req}) { | 
| 182 | 27 | 50 |  |  |  | 54 | exists($args{$attr}) | 
| 183 |  |  |  |  |  |  | or die "$class: Missing required attribute '$attr'"; | 
| 184 |  |  |  |  |  |  | } | 
| 185 | 151 | 100 |  |  |  | 232 | if (exists $attrspec->{$attr}{default}) { | 
| 186 | 88 |  | 100 |  |  | 227 | $args{$attr} //= $attrspec->{$attr}{default}; | 
| 187 |  |  |  |  |  |  | } | 
| 188 |  |  |  |  |  |  | } | 
| 189 | 18 |  |  |  |  | 40 | $args{_attempts} = 0; | 
| 190 | 18 |  | 66 |  |  | 143 | $args{_start_timestamp} //= time(); | 
| 191 | 18 |  |  |  |  | 61 | bless \%args, $class; | 
| 192 |  |  |  |  |  |  | } | 
| 193 |  |  |  |  |  |  |  | 
| 194 |  |  |  |  |  |  | sub _consider_actual_delay { | 
| 195 | 5 |  |  | 5 |  | 8 | my ($self, $delay, $timestamp) = @_; | 
| 196 |  |  |  |  |  |  |  | 
| 197 | 5 |  | 100 |  |  | 13 | $self->{_last_delay} //= 0; | 
| 198 | 5 |  |  |  |  | 7 | my $actual_delay = $timestamp - $self->{_last_timestamp}; | 
| 199 | 5 |  |  |  |  | 7 | my $new_delay = $delay + $self->{_last_delay} - $actual_delay; | 
| 200 | 5 |  |  |  |  | 6 | $self->{_last_delay} = $new_delay; | 
| 201 | 5 |  |  |  |  | 8 | $new_delay; | 
| 202 |  |  |  |  |  |  | } | 
| 203 |  |  |  |  |  |  |  | 
| 204 |  |  |  |  |  |  | sub _add_jitter { | 
| 205 | 120 |  |  | 120 |  | 151 | my ($self, $delay) = @_; | 
| 206 | 120 | 50 | 33 |  |  | 270 | return $delay unless $delay && $self->{jitter_factor}; | 
| 207 | 120 |  |  |  |  | 175 | my $min = $delay * (1-$self->{jitter_factor}); | 
| 208 | 120 |  |  |  |  | 145 | my $max = $delay * (1+$self->{jitter_factor}); | 
| 209 | 120 |  |  |  |  | 214 | $min + ($max-$min)*rand(); | 
| 210 |  |  |  |  |  |  | } | 
| 211 |  |  |  |  |  |  |  | 
| 212 |  |  |  |  |  |  | sub _success_or_failure { | 
| 213 | 200 |  |  | 200 |  | 283 | my ($self, $is_success, $timestamp) = @_; | 
| 214 |  |  |  |  |  |  |  | 
| 215 | 200 |  | 100 |  |  | 315 | $self->{_last_timestamp} //= $timestamp; | 
| 216 |  |  |  |  |  |  | $timestamp >= $self->{_last_timestamp} or | 
| 217 | 200 | 100 |  |  |  | 338 | die ref($self).": Decreasing timestamp ". | 
| 218 |  |  |  |  |  |  | "($self->{_last_timestamp} -> $timestamp)"; | 
| 219 |  |  |  |  |  |  |  | 
| 220 | 199 | 100 |  |  |  | 448 | my $delay = $is_success ? | 
| 221 |  |  |  |  |  |  | $self->_success($timestamp) : $self->_failure($timestamp); | 
| 222 |  |  |  |  |  |  |  | 
| 223 |  |  |  |  |  |  | $delay = $self->_consider_actual_delay($delay, $timestamp) | 
| 224 | 199 | 100 |  |  |  | 330 | if $self->{consider_actual_delay}; | 
| 225 |  |  |  |  |  |  |  | 
| 226 |  |  |  |  |  |  | $delay = $self->_add_jitter($delay) | 
| 227 | 199 | 100 |  |  |  | 322 | if $self->{jitter_factor}; | 
| 228 |  |  |  |  |  |  |  | 
| 229 |  |  |  |  |  |  | # keep between max(0, min_delay) and max_delay | 
| 230 |  |  |  |  |  |  | $delay = $self->{max_delay} | 
| 231 | 199 | 100 | 100 |  |  | 414 | if defined $self->{max_delay} && $delay > $self->{max_delay}; | 
| 232 | 199 | 100 |  |  |  | 339 | $delay = 0 if $delay < 0; | 
| 233 |  |  |  |  |  |  | $delay = $self->{min_delay} | 
| 234 | 199 | 100 | 66 |  |  | 500 | if defined $self->{min_delay} && $delay < $self->{min_delay}; | 
| 235 |  |  |  |  |  |  |  | 
| 236 | 199 |  |  |  |  | 264 | $self->{_last_timestamp} = $timestamp; | 
| 237 | 199 |  |  |  |  | 267 | $self->{_prev_delay}     = $delay; | 
| 238 | 199 |  |  |  |  | 463 | $delay; | 
| 239 |  |  |  |  |  |  | } | 
| 240 |  |  |  |  |  |  |  | 
| 241 |  |  |  |  |  |  | sub success { | 
| 242 | 88 |  |  | 88 | 1 | 7654 | my ($self, $timestamp) = @_; | 
| 243 |  |  |  |  |  |  |  | 
| 244 | 88 |  | 66 |  |  | 159 | $timestamp //= time(); | 
| 245 |  |  |  |  |  |  |  | 
| 246 | 88 |  |  |  |  | 111 | $self->{_attempts} = 0; | 
| 247 |  |  |  |  |  |  |  | 
| 248 | 88 |  |  |  |  | 131 | $self->_success_or_failure(1, $timestamp); | 
| 249 |  |  |  |  |  |  | } | 
| 250 |  |  |  |  |  |  |  | 
| 251 |  |  |  |  |  |  | sub failure { | 
| 252 | 116 |  |  | 116 | 1 | 588 | my ($self, $timestamp) = @_; | 
| 253 |  |  |  |  |  |  |  | 
| 254 | 116 |  | 66 |  |  | 201 | $timestamp //= time(); | 
| 255 |  |  |  |  |  |  |  | 
| 256 |  |  |  |  |  |  | return -1 if defined $self->{max_actual_duration} && | 
| 257 |  |  |  |  |  |  | $self->{max_actual_duration} > 0 && | 
| 258 | 116 | 100 | 66 |  |  | 384 | $timestamp - $self->{_start_timestamp} >= $self->{max_actual_duration}; | 
|  |  |  | 100 |  |  |  |  | 
| 259 |  |  |  |  |  |  |  | 
| 260 | 115 |  |  |  |  | 151 | $self->{_attempts}++; | 
| 261 |  |  |  |  |  |  | return -1 if $self->{max_attempts} && | 
| 262 | 115 | 100 | 100 |  |  | 196 | $self->{_attempts} >= $self->{max_attempts}; | 
| 263 |  |  |  |  |  |  |  | 
| 264 | 112 |  |  |  |  | 197 | $self->_success_or_failure(0, $timestamp); | 
| 265 |  |  |  |  |  |  | } | 
| 266 |  |  |  |  |  |  |  | 
| 267 |  |  |  |  |  |  | 1; | 
| 268 |  |  |  |  |  |  | # ABSTRACT: Various backoff strategies for retry | 
| 269 |  |  |  |  |  |  |  | 
| 270 |  |  |  |  |  |  | __END__ |