← Back to branch summary

~percona-toolkit-dev/percona-toolkit/fix-log-parser-writer-bug-963225

« back to all changes in this revision

Viewing changes to lib/Retry.pm

  • Committer: Daniel Nichter
  • Date: 2011-06-24 17:22:06 UTC
  • Revision ID: daniel@percona.com-20110624172206-c7q4s4ad6r260zz6
Add lib/, t/lib/, and sandbox/.  All modules are updated and passing on MySQL 5.1.

Show diffs side-by-side

added added

removed removed

Lines of Context:
lib/Retry.pm
 
1
# This program is copyright 2010-2011 Percona Inc.
 
2
# Feedback and improvements are welcome.
 
3
#
 
4
# THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
 
5
# WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
 
6
# MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
 
7
#
 
8
# This program is free software; you can redistribute it and/or modify it under
 
9
# the terms of the GNU General Public License as published by the Free Software
 
10
# Foundation, version 2; OR the Perl Artistic License.  On UNIX and similar
 
11
# systems, you can issue `man perlgpl' or `man perlartistic' to read these
 
12
# licenses.
 
13
#
 
14
# You should have received a copy of the GNU General Public License along with
 
15
# this program; if not, write to the Free Software Foundation, Inc., 59 Temple
 
16
# Place, Suite 330, Boston, MA  02111-1307  USA.
 
17
# ###########################################################################
 
18
# Retry package $Revision: 7473 $
 
19
# ###########################################################################
 
20
package Retry;
 
21
 
 
22
use strict;
 
23
use warnings FATAL => 'all';
 
24
use English qw(-no_match_vars);
 
25
use constant MKDEBUG => $ENV{MKDEBUG} || 0;
 
26
 
 
27
sub new {
 
28
   my ( $class, %args ) = @_;
 
29
   my $self = {
 
30
      %args,
 
31
   };
 
32
   return bless $self, $class;
 
33
}
 
34
 
 
35
# Required arguments:
 
36
#   * try          coderef: code to try; return true on success
 
37
#   * wait         coderef: code that waits in between tries
 
38
# Optional arguments:
 
39
#   * tries        scalar: number of retries to attempt (default 3)
 
40
#   * retry_on_die bool: retry try code if it dies (default no)
 
41
#   * on_success   coderef: code to call if try is successful
 
42
#   * on_failure   coderef: code to call if try does not succeed
 
43
# Retries the try code until either it returns true or we exhaust
 
44
# the number of retry attempts.  The args are passed to the coderefs
 
45
# (try, wait, on_success, on_failure).  If the try code dies, that's
 
46
# a final failure (no more retries) unless retry_on_die is true.
 
47
# Returns either whatever the try code returned or undef on failure.
 
48
sub retry {
 
49
   my ( $self, %args ) = @_;
 
50
   my @required_args = qw(try wait);
 
51
   foreach my $arg ( @required_args ) {
 
52
      die "I need a $arg argument" unless $args{$arg};
 
53
   };
 
54
   my ($try, $wait) = @args{@required_args};
 
55
   my $tries = $args{tries} || 3;
 
56
 
 
57
   my $tryno = 0;
 
58
   while ( ++$tryno <= $tries ) {
 
59
      MKDEBUG && _d("Retry", $tryno, "of", $tries);
 
60
      my $result;
 
61
      eval {
 
62
         $result = $try->(tryno=>$tryno);
 
63
      };
 
64
 
 
65
      if ( defined $result ) {
 
66
         MKDEBUG && _d("Try code succeeded");
 
67
         if ( my $on_success = $args{on_success} ) {
 
68
            MKDEBUG && _d("Calling on_success code");
 
69
            $on_success->(tryno=>$tryno, result=>$result);
 
70
         }
 
71
         return $result;
 
72
      }
 
73
 
 
74
      if ( $EVAL_ERROR ) {
 
75
         MKDEBUG && _d("Try code died:", $EVAL_ERROR);
 
76
         die $EVAL_ERROR unless $args{retry_on_die};
 
77
      }
 
78
 
 
79
      # Wait if there's more retries, else end immediately.
 
80
      if ( $tryno < $tries ) {
 
81
         MKDEBUG && _d("Try code failed, calling wait code");
 
82
         $wait->(tryno=>$tryno);
 
83
      }
 
84
   }
 
85
 
 
86
   MKDEBUG && _d("Try code did not succeed");
 
87
   if ( my $on_failure = $args{on_failure} ) {
 
88
      MKDEBUG && _d("Calling on_failure code");
 
89
      $on_failure->();
 
90
   }
 
91
 
 
92
   return;
 
93
}
 
94
 
 
95
sub _d {
 
96
   my ($package, undef, $line) = caller 0;
 
97
   @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
 
98
        map { defined $_ ? $_ : 'undef' }
 
99
        @_;
 
100
   print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
 
101
}
 
102
 
 
103
1;
 
104
 
 
105
# ###########################################################################
 
106
# End Retry package
 
107
# ###########################################################################