Action-Retry

 view release on metacpan or  search on metacpan

lib/Action/Retry.pm  view on Meta::CPAN

89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
if (my $timestamp = $self->_needs_sleeping_until) {
    # we can't retry until we have waited enough time 
    my ($seconds, $microseconds) = gettimeofday;
    $seconds * 1000 + int($microseconds / 1000) >= $timestamp
      or return;
    $self->_needs_sleeping_until(0);
    $self->strategy->next_step;
}
 
my $error;
my @attempt_result;
my $attempt_result;
my $wantarray;
   
if (wantarray) {
    $wantarray = 1;
    @attempt_result = eval { $self->attempt_code->(@_) };
    $error = $@;
} elsif ( ! defined wantarray ) {
    eval { $self->attempt_code->(@_) };
    $error = $@;
} else {
    $attempt_result = eval { $self->attempt_code->(@_) };
    $error = $@;
}
 
my $h = { action_retry => $self,
          attempt_result => ( $wantarray ? \@attempt_result : $attempt_result ),
          attempt_parameters => \@_,
        };
 
 
$self->retry_if_code->($error, $h )
  or $self->strategy->reset, $@ = $error, return ( $wantarray ? @attempt_result : $attempt_result );
 
if (! $self->strategy->needs_to_retry) {
    $self->strategy->reset;
    $self->has_on_failure_code
      and return $self->on_failure_code->($error, $h);
    return;
}
 
if ($self->non_blocking) {
    my ($seconds, $microseconds) = gettimeofday;
    $self->_needs_sleeping_until($seconds * 1000 + int($microseconds / 1000) + $self->strategy->compute_sleep_time);
} else {
    usleep($self->strategy->compute_sleep_time * 1000);
    $self->strategy->next_step;
}

lib/Action/Retry.pm  view on Meta::CPAN

305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
C<retry_if_code> return value will be interpreted as a boolean : true return
value means the execution of C<attempt_code> was a failure and it needs to be
retried. False means it went well.
 
Here is an example of code that gets the arguments properly:
 
  my $action = Action::Retry->new(
    attempt_code => sub { do_stuff; } )->run();
    attempt_code => sub { map { $_ * 2 } @_ }
    retry_if_code => sub {
      my ($error, $h) = @_;
 
      my $attempt_code_result = $h->{attempt_result};
      my $attempt_code_params = $h->{attempt_parameters};
 
      my @results = @$attempt_code_result;
      # will contains (2, 4);
 
      my @original_parameters = @$attempt_code_params;
      # will contains (1, 2);

lib/Action/Retry.pm  view on Meta::CPAN

378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
 
=head2 run
 
Does the following:
 
=over
 
=item step 1
 
Runs the C<attempt_code> CodeRef in the proper context in an eval {} block,
saving C<$@> in C<$error>.
 
=item step 2
 
Runs the C<retry_if_code> CodeRef in scalar context, giving it as arguments
C<$error>, and the return values of C<attempt_code>. If it returns true, we
consider that it was a failure, and move to step 3. Otherwise, we consider it
means success, and return the return values of C<attempt_code>.
 
=item step 3
 
Ask the C<strategy> if it's still useful to retry. If yes, sleep accordingly,
and go back to step 2. If not, go to step 4.
 
=item step 4
 
Runs the C<on_failure_code> CodeRef in the proper context, giving it as
arguments C<$error>, and the return values of C<attempt_code>, and returns the
results back to the caller.
 
=back
 
Arguments passed to C<run()> will be passed to C<attempt_code>. They will also
passed to C<on_failure_code> as well if the case arises.
 
=head2 retry
 
  retry { ..code.. } some => 'arguments';

t/check_params.t  view on Meta::CPAN

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
 
use strict;
use warnings;
 
use Test::More;
 
{
    my $var = 0;
    my $action = Action::Retry->new(
        attempt_code => sub { my ($val) = @_; $var++; die "plop\n" if $var < 5; return $var + $val; },
        retry_if_code => sub { my ($error, $h) = @_;
                               chomp $error;
                               if ($var < 5) {
                                   is $error, "plop";
                                   return 1;
                               } else {
                                   ok ! $error;
                                   is $h->{attempt_result}, $var + $h->{attempt_parameters}[0];
                                   return 0;
                               }
                           },
        strategy => { Fibonacci => { initial_term_index => 0, multiplicator => 10 } },
    );
    my $result = $action->run(2);
    is($result, 7);
}

t/fibonacci.t  view on Meta::CPAN

48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
}
 
{
    my @expected = (5, 8, 13, 21, 34, 55, 89, 144, 233, 377, 610);
    my @got;
 
    my $var = 0;
    my $acc = 0;
    my $action = Action::Retry->new(
        attempt_code => sub { my ($val) = @_; $acc+=$val; $var++; die "plop" },
        retry_if_code => sub { my ($error, $h) = @_; push @got, $h->{action_retry}->strategy->compute_sleep_time; $error; },
        strategy => { Fibonacci => { initial_term_index => 5, multiplicator => 1 } },
    );
    $action->run(2);
    is($var, 11);
    is($acc, 22);
    is_deeply(\@got, \@expected, 'starting with an initial_term_index works');
}
done_testing;