view release on metacpan or  search on metacpan

lib/Algorithm/Backoff/RetryTimeouts.pm  view on Meta::CPAN

package Algorithm::Backoff::RetryTimeouts;

use utf8;
use strict;
use warnings;

use Algorithm::Backoff::Exponential;
use base qw< Algorithm::Backoff::Exponential >;

use Storable    qw< dclone >;
use Time::HiRes qw< time   >;

use namespace::clean;

# ABSTRACT: A backoff-style retry algorithm with adjustable timeout support
use version;
our $VERSION = 'v1.0.0'; # VERSION

#pod =head1 SYNOPSIS
#pod
#pod     use Algorithm::Backoff::RetryTimeouts;
#pod
#pod     my $retry_algo = Algorithm::Backoff::RetryTimeouts->new(
#pod         # common adjustments (defaults shown)
#pod         max_attempts          => 8,
#pod         max_actual_duration   => 50,
#pod         jitter_factor         => 0.1,
#pod         timeout_jitter_factor => 0.1,
#pod         adjust_timeout_factor => 0.5,
#pod         min_adjust_timeout    => 5,
#pod
#pod         # other defaults
#pod         initial_delay         => sqrt(2),
#pod         exponent_base         => sqrt(2),
#pod         delay_on_success      => 0,
#pod         min_delay             => 0,
#pod         max_delay             => undef,
#pod         consider_actual_delay => 1,
#pod     );
#pod
#pod     my ($delay, $timeout);
#pod     $timeout = $retry_algo->timeout;
#pod
#pod     my $is_successful = 0;
#pod     while (!$is_successful) {
#pod         $actionee->timeout( $timeout );
#pod         $is_successful = $actionee->do_the_thing;
#pod
#pod         ($delay, $timeout) = $is_successful ? $retry_algo->success : $retry_algo->failure;
#pod         die "Ran out of time" if $delay == -1;
#pod         sleep $delay;
#pod     }
#pod
#pod =head1 DESCRIPTION
#pod
#pod This module is a subclass of L<Algorithm::Backoff::Exponential> that adds support for
#pod adjustable timeouts during each retry.  This also comes with a sane set of defaults as a
#pod good baseline for most kinds of retry operations.
#pod
#pod A combination of features solves for most problems that would arise from retry operations:
#pod
#pod =over
#pod
#pod =item *
#pod
#pod B<Maximum attempts> - Forces the algorithm to give up if repeated attempts don't yield
#pod success.
#pod
#pod =item *
#pod
#pod B<Maximum duration> - Forces the algorithm to give up if no successes happen within a
#pod certain time frame.
#pod
#pod =item *
#pod

lib/Algorithm/Backoff/RetryTimeouts.pm  view on Meta::CPAN

    $delay = $max_delay if $delay > $max_delay;

    # Re-adjust the timeout based on the final delay and min timeout setting
    $timeout = ($actual_time_left - $delay) * $timeout_factor;
    $timeout = $self->_add_timeout_jitter($timeout) if $self->{timeout_jitter_factor};
    $timeout = $min_time if $min_time > $timeout;

    $self->{_prev_delay}   = $delay;
    $self->{_last_timeout} = $timeout;

    return ($delay, $timeout);
}

sub _add_timeout_jitter {
    my ($self, $timeout) = @_;
    my $jitter = $self->{timeout_jitter_factor};
    return $timeout unless $timeout && $jitter;

    my $min = $timeout * (1 - $jitter);
    my $max = $timeout * (1 + $jitter);
    return $min + ($max - $min) * rand();
}

sub _consider_actual_delay {
    my $self = shift;

    # See https://github.com/perlancar/perl-Algorithm-Backoff/issues/1
    $self->{_last_delay} = $self->{_prev_delay} //= 0;

    return $self->SUPER::_consider_actual_delay(@_);
}

sub _success_or_failure {
    my ($self, $is_success, $timestamp) = @_;

    # If this is the first time, the _last_timestamp should be set to the start, not
    # $timestamp.  This will prevent issues with the first attempt causing unnecessary
    # delays (ie: waiting 1.4s after the first attempt took longer than that).
    $self->{_last_timestamp} //= $self->{_start_timestamp};

    my $delay = $self->SUPER::_success_or_failure($is_success, $timestamp);
    return $self->_set_last_timeout($delay, $timestamp);
}

#pod =head1 SEE ALSO
#pod
#pod L<Algorithm::Backoff> - Base distro for this module
#pod
#pod =cut

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

Algorithm::Backoff::RetryTimeouts - A backoff-style retry algorithm with adjustable timeout support

=head1 VERSION

version v1.0.0

=head1 SYNOPSIS

    use Algorithm::Backoff::RetryTimeouts;

    my $retry_algo = Algorithm::Backoff::RetryTimeouts->new(
        # common adjustments (defaults shown)
        max_attempts          => 8,
        max_actual_duration   => 50,
        jitter_factor         => 0.1,
        timeout_jitter_factor => 0.1,
        adjust_timeout_factor => 0.5,
        min_adjust_timeout    => 5,

        # other defaults
        initial_delay         => sqrt(2),
        exponent_base         => sqrt(2),
        delay_on_success      => 0,
        min_delay             => 0,
        max_delay             => undef,
        consider_actual_delay => 1,
    );

    my ($delay, $timeout);
    $timeout = $retry_algo->timeout;

    my $is_successful = 0;
    while (!$is_successful) {
        $actionee->timeout( $timeout );
        $is_successful = $actionee->do_the_thing;

        ($delay, $timeout) = $is_successful ? $retry_algo->success : $retry_algo->failure;
        die "Ran out of time" if $delay == -1;
        sleep $delay;
    }

=head1 DESCRIPTION

This module is a subclass of L<Algorithm::Backoff::Exponential> that adds support for
adjustable timeouts during each retry.  This also comes with a sane set of defaults as a
good baseline for most kinds of retry operations.

A combination of features solves for most problems that would arise from retry operations:

=over

=item *

B<Maximum attempts> - Forces the algorithm to give up if repeated attempts don't yield
success.

=item *

B<Maximum duration> - Forces the algorithm to give up if no successes happen within a
certain time frame.