File Coverage

blib/lib/Proc/BackOff/Exponential.pm
Criterion Covered Total %
statement 21 25 84.0
branch 5 8 62.5
condition 3 9 33.3
subroutine 5 5 100.0
pod 2 2 100.0
total 36 49 73.4


line stmt bran cond sub pod time code
1             package Proc::BackOff::Exponential;
2              
3             # Inheritance
4 2     2   27971 use base qw( Proc::BackOff );
  2         5  
  2         865  
5              
6             # Set up get/set fields
7             # 2 ^ 5
8             # 2 is the base
9             # 5 is the exponent
10              
11             __PACKAGE__->mk_accessors( 'base',
12             'exponent',
13             );
14              
15             # standard pragmas
16 2     2   12 use warnings;
  2         3  
  2         53  
17 2     2   9 use strict;
  2         3  
  2         556  
18              
19             # standard perl modules
20              
21             # CPAN & others
22              
23             our $VERSION = '0.01';
24              
25             =head1 NAME
26              
27             Proc::BackOff::Exponential
28              
29             =head1 SYNOPSIS
30              
31             Usage:
32              
33             use Proc::BackOff::Exponential;
34              
35             my $obj = Proc::BackOff::Exponential->new( { base => 2 , exponent=> 'count' } );
36             # On N'th failure delay would be set to:
37             # 1st failure : 2^1 = 2
38             # 2nd failure : 2^2 = 4
39             # 3rd failure : 2^3 = 8
40             # 4th failure : 2^4 = 16
41              
42             # or
43              
44             my $obj = Proc::BackOff::Exponential->new( { base => 'count' , exponent=> 2 } );
45             # On N'th failure delay would be set to:
46             # 1st failure : 1^2 = 1
47             # 2nd failure : 2^2 = 4
48             # 3rd failure : 3^2 = 9
49             # 4th failure : 4^2 = 16
50              
51             See L for further documentation.
52              
53             =head1 Overloaded Methods
54              
55             =head2 new()
56              
57             Check for variables being set
58              
59             Required: base
60             Required: exponent
61              
62             =cut
63              
64             sub new {
65 2     2 1 9616 my $proto = shift;
66 2   33     20 my $class = ref $proto || $proto;
67 2         20 my $obj = $class->SUPER::new(@_);
68              
69 2 50 33     10 if ( ! defined $obj->exponent() || ! $obj->valid_number_check($obj->exponent())) {
70 0         0 warn "$proto: Exponent value not set";
71 0         0 return undef;
72             }
73              
74 2 50 33     10 if ( ! defined $obj->base() || ! $obj->valid_number_check($obj->base())) {
75 0         0 warn "$proto: Base value not set";
76 0         0 return undef;
77             }
78              
79 2         8 return $obj;
80             }
81              
82             =head2 calculate_back_off()
83              
84             Returns the new back off value.
85              
86             =cut
87              
88             sub calculate_back_off {
89 20     20 1 29 my $self = shift;
90              
91             # this is an exponential back off
92              
93 20         48 my $exponent = $self->exponent();
94 20         197 my $base = $self->base();
95              
96 20 100       201 $exponent = $self->failure_count() if $exponent eq 'count';
97 20 50       147 $base = $self->failure_count() if $base eq 'count';
98              
99 20         271 return $base ^ $exponent;
100             }
101              
102             =cut
103              
104             1;
105              
106             =head1 Changes
107              
108             0.02 2007-08-12 -- Daniel Lo
109             - Documentation fixes. No code changes.
110              
111             0.01 2007-04-17 -- Daniel Lo
112             - Initial Version
113              
114             =head1 AUTHOR
115              
116             Daniel Lo
117              
118             =head1 LICENSE
119              
120             Copyright (C) PictureTrail Inc. 1999-2007
121             Santa Clara, California, United States of America.
122              
123             This code is released to the public for public use under Perl's Artisitic
124             licence.
125              
126             =cut