view release on metacpan or  search on metacpan

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

#pod
#pod The following new options are added in this module:
#pod
#pod =over
#pod
#pod =item * adjust_timeout_factor => I<ufloat> (default: 0.5)
#pod
#pod How much of the remaining time to use for the next attempt's timeout, as a
#pod factor between 0 and 1.
#pod
#pod In order to prevent a single attempt from using up all of the remaining time, an
#pod adjustable timeout will force the attempt to only use a portion of the time.  By default,
#pod only 50% of the remaining time will be set as the next timeout value.
#pod
#pod =item * min_adjust_timeout => I<ufloat> (default: 5)
#pod
#pod Minimum timeout value, in seconds.
#pod
#pod This value bypasses any C<max_actual_duration> checks, so the total time spent on
#pod sleeping and attempts may end up exceeding that value by a small amount (up to
#pod C<max_actual_duration + min_adjust_timeout>).  In this case, future failures will return
#pod a delay of C<-1> as expected.
#pod
#pod =item * timeout_jitter_factor => I<float> (default: 0.1)
#pod
#pod How much randomness to add to the adjustable timeout.
#pod
#pod Delay jitter may not be enough to desynchronize two processes that are consistently
#pod timing out on the same problem.  In those cases, the delay will usually be zero and won't
#pod have any sort of jitter to solve the problem itself.  A jitter factor against the timeout
#pod will ensure simultaneous attempts have slightly different timeout windows.
#pod
#pod =back
#pod
#pod =head1 METHODS
#pod
#pod =head2 success
#pod
#pod     my ($delay, $timeout) = $retry_algo->success([ $timestamp ]);
#pod
#pod Log a successful attempt.  If not specified, C<$timestamp> defaults to current time.
#pod Unlike the L<base class|Algorithm::Backoff>, this method will return a list containing
#pod both the L<suggested delay|/delay> and the L<suggested timeout|/timeout> for the next
#pod attempt.
#pod
#pod =head2 failure
#pod
#pod     my ($delay, $timeout) = $retry_algo->failure([ $timestamp ]);
#pod
#pod Log a failed attempt.  If not specified, C<$timestamp> defaults to current time.
#pod Unlike the L<base class|Algorithm::Backoff>, this method will return a list containing
#pod both the L<suggested delay|/delay> and the L<suggested timeout|/timeout> for the next
#pod attempt.
#pod
#pod =cut

sub failure {
    my ($self, $timestamp) = @_;
    $timestamp //= time;

    my ($delay, $timeout) = $self->SUPER::failure($timestamp);

    # Fix certain values if the check failed max duration/attempts checks
    $timeout //= $self->timeout;
    if ($delay == -1) {
        $self->{_attempts}++;
        $self->{_last_timestamp} = $timestamp;
    }

    return ($delay, $timeout);
}

#pod =head2 delay
#pod
#pod     my $delay = $retry_algo->delay;
#pod
#pod Returns the last suggested delay, in seconds.
#pod
#pod The delay will return C<-1> to suggest that the process should give up and fail, if
#pod C<max_attempts> or C<max_actual_duration> have been reached.
#pod
#pod =cut

sub delay {
    my $self = shift;
    return $self->{_prev_delay} // 0;
}

#pod =head2 timeout
#pod
#pod     my $timeout = $retry_algo->delay;
#pod
#pod Returns the last suggested timeout, in seconds.  If no attempts have been logged,
#pod it will suggest an initial timeout to start with.
#pod
#pod This will be a floating-point number, so you may need to convert it to an integer if your
#pod timeout system doesn't support decimals.
#pod
#pod A timeout of C<-1> will be returned if C<max_actual_duration> was forcefully turned off.
#pod
#pod =cut

sub timeout {
    my $self = shift;

    my $last_timeout   = $self->{_last_timeout};
    my $min_time       = $self->{min_adjust_timeout};
    my $max_time       = $self->{max_actual_duration};
    my $timeout_factor = $self->{adjust_timeout_factor};

    return $last_timeout if defined $last_timeout;
    return -1 unless $max_time;

    my $timeout = $max_time * $timeout_factor;
    $timeout = $self->_add_timeout_jitter($timeout) if $self->{timeout_jitter_factor};
    $timeout = $min_time if $min_time > $timeout;
    return $timeout;
}

sub _set_last_timeout {
    my ($self, $delay, $timestamp) = @_;

    my $start_time     = $self->{_start_timestamp};
    my $min_time       = $self->{min_adjust_timeout};
    my $max_time       = $self->{max_actual_duration};
    my $timeout_factor = $self->{adjust_timeout_factor};
    return ($delay // 0, -1) unless defined $start_time && $max_time;

    $timestamp //= $self->{_last_timestamp} // $self->{_start_timestamp};

    # Calculate initial timeout
    my $actual_time_used = $timestamp - $start_time;
    my $actual_time_left = $max_time - $actual_time_used;
    my $timeout          = $actual_time_left * $timeout_factor;

    # Ensure the delay+timeout time isn't going to go over the limit
    $delay //= 0;
    my $max_delay = $actual_time_left * (1 - $timeout_factor);
    $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;
    }