File Coverage

blib/lib/Action/Retry.pm

Criterion	Covered	Total	%
statement	52	54	96.3
branch	20	22	90.9
condition			n/a
subroutine	8	8	100.0
pod	2	2	100.0
total	82	86	95.3

#
# This file is part of Action-Retry
#
# This software is copyright (c) 2013 by Damien "dams" Krotkine.
#
# This is free software; you can redistribute it and/or modify it under
# the same terms as the Perl 5 programming language system itself.
#
package Action::Retry;
{
  $Action::Retry::VERSION = '0.24';
}

# ABSTRACT: Module to try to perform an action, with various ways of retrying and sleeping between retries.

use Module::Runtime qw(use_module);
use Scalar::Util qw(blessed);
use Time::HiRes qw(usleep gettimeofday);
use Carp;

use base 'Exporter';
our @EXPORT_OK = qw(retry);
# export by default if run from command line
our @EXPORT = ((caller())[1] eq '-e' ? @EXPORT_OK : ());

use Moo;



has attempt_code => (
    is => 'ro',
    required => 1,
    isa => sub { ref $_[0] eq 'CODE' },
);


has retry_if_code => (
    is => 'ro',
    required => 1,
    isa => sub { ref $_[0] eq 'CODE' },
    default => sub { sub { $_[0] }; },
);


has on_failure_code => (
    is => 'ro',
    isa => sub { ref $_[0] eq 'CODE' },
    predicate => 1,
);


has strategy => (
    is => 'ro',
    default => sub { 'Constant' },
    coerce => sub {
        my $attr = $_[0];
        blessed($attr)
          and return $attr;
        my $class_name = $attr;
        my $constructor_params = {};
        if (ref $attr eq 'HASH') {
            $class_name = (keys %$attr)[0];
            $constructor_params = $attr->{$class_name};
        }
        $class_name = $class_name =~ /^\+(.+)$/ ? $1 : "Action::Retry::Strategy::$class_name";
        return use_module($class_name)->new($constructor_params);
    },
    isa => sub { $_[0]->does('Action::Retry::Strategy') or croak 'Should consume the Action::Retry::Strategy role' },
);


has non_blocking => (
    is => 'ro',
    default => sub { 0 },
);

# For non blocking mode, store the timestamp after which we can retry
has _needs_sleeping_until => (
    is => 'rw',
    default => sub { 0 },
    init_arg => undef,
);


sub run {
    my $self = shift;

    while(1) {

        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;
        }
    }
}


sub retry (&;@) {
    my $code = shift;
    @_ % 2
      and croak "arguments to retry must be a CodeRef, and an even number of key / values";
    my %args = @_;
    Action::Retry->new( attempt_code => $code, %args )->run();
}


1;

__END__