File Coverage

blib/lib/CPAN/MirrorMerger/RetryPolicy.pm
Criterion Covered Total %
statement 12 42 28.5
branch 0 12 0.0
condition n/a
subroutine 4 7 57.1
pod 0 2 0.0
total 16 63 25.4


line stmt bran cond sub pod time code
1             package CPAN::MirrorMerger::RetryPolicy;
2 2     2   17 use strict;
  2         6  
  2         67  
3 2     2   11 use warnings;
  2         5  
  2         58  
4              
5 2     2   11 use Time::HiRes ();
  2         6  
  2         52  
6              
7 2     2   10 use Class::Accessor::Lite ro => [qw/max_retries interval jitter_factor/], new => 1;
  2         5  
  2         35  
8              
9             sub apply {
10 0     0 0   my ($self, $code) = @_;
11             return sub {
12 0     0     my $wantarray = wantarray;
13              
14 0           my $e;
15 0           my $retry_count = 0;
16 0           my $interval = $self->interval * 1_000_000; # usec
17              
18 0           my @ret;
19 0           while ($retry_count < $self->max_retries) {
20 0           eval {
21 0 0         if ($wantarray) {
    0          
22 0           @ret = $code->($retry_count, $e);
23             } elsif (defined $wantarray,) {
24 0           $ret[0] = $code->($retry_count, $e);
25             } else {
26 0           $code->($retry_count, $e);
27             }
28             };
29 0 0         if ($@) {
30             # retry
31 0           $e = $@;
32 0           $retry_count++;
33              
34 0           $interval *= 2;
35 0 0         if ($self->jitter_factor) {
36 0           my $delta = $interval * $self->jitter_factor;
37 0           my $min = $interval - $delta;
38 0           $interval = $min + rand(1+2*$delta);
39             }
40              
41 0           Time::HiRes::usleep($interval);
42 0           next;
43             }
44              
45 0           $e = undef;
46 0           last;
47             }
48 0 0         die $e if $e;
49              
50 0 0         return $wantarray ? @ret : $ret[0];
51 0           };
52             }
53              
54             sub apply_and_doit {
55 0     0 0   my $self = shift;
56 0           my $code = shift;
57 0           return $self->apply($code)->();
58             }
59              
60             1;
61             __END__