File Coverage

blib/lib/Retry.pm
Criterion Covered Total %
statement 24 24 100.0
branch 4 4 100.0
condition n/a
subroutine 5 5 100.0
pod 1 1 100.0
total 34 34 100.0


line stmt bran cond sub pod time code
1             package Retry;
2 2     2   17238 use strict;
  2         5  
  2         51  
3 2     2   9 use warnings;
  2         2  
  2         55  
4 2     2   1123 use Moo;
  2         19622  
  2         9  
5 2     2   3828 use MooX::Types::MooseLike::Base qw( Int CodeRef );
  2         9559  
  2         468  
6              
7             our $VERSION = '1.03';
8              
9             =head1 NAME
10              
11             Retry
12              
13             =head1 SYNOPSIS
14              
15             A one-feature module, this provides a method to wrap any function in automatic
16             retry logic, with exponential back-off delays, and a callback for each time an
17             attempt fails.
18              
19             Example:
20              
21             use Retry;
22             use Try::Tiny;
23             use LWP::UserAgent;
24              
25             my $code_to_retry = sub {
26             my $r = LWP::UserAgent->new->get("http://example.com");
27             die $r->status_line unless $r->is_success;
28             return $r;
29             };
30              
31             my $agent = Retry->new(
32             # This callback is optional:
33             failure_callback => sub { warn "Transient error: " . $_[0]; },
34             );
35              
36             try {
37             $agent->retry($code_to_retry)
38             }
39             catch {
40             warn "All attempts failed: $_";
41             };
42              
43             =head1 ATTRIBUTES
44              
45             =cut
46              
47             =head2 retry_delay
48              
49             This is the initial delay used when the routine failed, before retrying again.
50              
51             Every subsequent failure doubles the amount.
52              
53             It defaults to 8 seconds.
54              
55             =cut
56              
57             has 'retry_delay' => (
58             is => 'rw',
59             isa => Int,
60             default => 8
61             );
62              
63             =head2 max_retry_attempts
64              
65             The maximum number of retries we should attempt before giving up completely.
66              
67             It defaults to 5.
68              
69             =cut
70              
71             has 'max_retry_attempts' => (
72             is => 'rw',
73             isa => Int,
74             default => 5,
75             );
76              
77             =head2 failure_callback
78              
79             Optional. To be notified of *every* failure (even if we eventually succeed on a
80             later retry), install a subroutine callback here.
81              
82             For example:
83              
84             Retry->new(
85             failure_callback => sub { warn "failed $count++ times" }
86             );
87              
88             =cut
89              
90             has 'failure_callback' => (
91             is => 'rw',
92             isa => CodeRef,
93             default => sub { sub {} }, # The way of the Moose is sometimes confusing.
94             );
95              
96             =head1 METHODS
97              
98             =head2 retry
99              
100             Its purpose is to execute the passed subroutine, over and over, until it
101             succeeds, or the number of retries is exceeded. The delay between retries
102             increases exponentially. (Failure is indicated by the sub dying)
103              
104             If the subroutine succeeds, then its scalar return value will be returned by
105             retry.
106              
107             For example, you could replace this:
108              
109             my $val = unreliable_web_request();
110              
111             With this:
112              
113             my $val = Retry->new->retry(
114             sub { unreliable_web_request() }
115             );
116              
117             =cut
118              
119             sub retry {
120 6     6 1 2296 my ($self, $sub) = @_;
121              
122 6         144 my $delay = $self->retry_delay;
123 6         173 my $retries = $self->max_retry_attempts;
124              
125 6         48 while () {
126 21         79 my $result = eval { $sub->() };
  21         138  
127 21 100       458 return $result unless $@;
128 16         42 my $error = $@;
129 16         686 $self->failure_callback->($error);
130              
131 16 100       104 die($error) unless $retries--;
132              
133 15         35001742 sleep($delay);
134 15         180 $delay *= 2;
135             }
136             }
137              
138             =head1 AUTHOR
139              
140             Toby Corkindale -- L
141              
142             =head1 LICENSE
143              
144             This module is released under the Perl Artistic License 2.0: L
145              
146             It is based upon source code which is Copyright 2010 Strategic Data Pty Ltd,
147             however it is used and released with permission.
148              
149             =head1 SEE ALSO
150              
151             L
152              
153             Retry differs from Attempt in having exponentially increasing delays, and by
154             having a callback inbetween attempts.
155              
156             However L has a simpler syntax.
157              
158             =cut
159              
160             1;