view release on metacpan or  search on metacpan

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

    initial_delay => {
        summary => 'Initial delay for the first attempt after failure, '.
            'in seconds',
        schema => 'ufloat*',
        req => 1,
    },
);

our %attr_delay_multiple_on_failure = (
    delay_multiple_on_failure => {
        summary => 'How much to multiple previous delay, upon failure (e.g. 1.5)',
        schema => 'ufloat*',
        req => 1,
   },
);

our %attr_delay_multiple_on_success = (
    delay_multiple_on_success => {
        summary => 'How much to multiple previous delay, upon success (e.g. 0.5)',
        schema => 'ufloat*',
        req => 1,
   },
);

our %attr_delay_increment_on_failure = (
    delay_increment_on_failure => {
        summary => 'How much to add to previous delay, in seconds, upon failure (e.g. 5)',
        schema => 'float*',
        req => 1,
   },
);

our %attr_delay_increment_on_success = (
    delay_increment_on_success => {
        summary => 'How much to add to previous delay, in seconds, upon success (e.g. -5)',
        schema => 'float*',
        req => 1,
   },
);

$SPEC{new} = {
    v => 1.1,
    is_class_meth => 1,
    is_func => 0,
    args => {
        %attr_max_attempts,
        %attr_jitter_factor,
    },
    result_naked => 1,
    result => {
        schema => 'obj*',
    },
};
sub new {
    my ($class, %args) = @_;

    my $attrspec = ${"$class\::SPEC"}{new}{args};

    # check known attributes
    for my $arg (keys %args) {
        $arg =~ /\A(_start_timestamp)\z/ and next;
        $attrspec->{$arg} or die "$class: Unknown attribute '$arg'";
    }
    # check required attributes and set default
    for my $attr (keys %$attrspec) {
        if ($attrspec->{$attr}{req}) {
            exists($args{$attr})
                or die "$class: Missing required attribute '$attr'";
        }
        if (exists $attrspec->{$attr}{default}) {
            $args{$attr} //= $attrspec->{$attr}{default};
        }
    }
    $args{_attempts} = 0;
    $args{_start_timestamp} //= time();
    bless \%args, $class;
}

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

    $self->{_prev_delay} //= 0;
    my $actual_delay = $timestamp - $self->{_last_timestamp};
    my $new_delay = $delay + $self->{_prev_delay} - $actual_delay;
    $new_delay;
}

sub _add_jitter {
    my ($self, $delay) = @_;
    return $delay unless $delay && $self->{jitter_factor};
    my $min = $delay * (1-$self->{jitter_factor});
    my $max = $delay * (1+$self->{jitter_factor});
    $min + ($max-$min)*rand();
}

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

    $self->{_last_timestamp} //= $timestamp;
    $timestamp >= $self->{_last_timestamp} or
        die ref($self).": Decreasing timestamp ".
        "($self->{_last_timestamp} -> $timestamp)";

    my $delay = $is_success ?
        $self->_success($timestamp) : $self->_failure($timestamp);

    $delay = $self->_consider_actual_delay($delay, $timestamp)
        if $self->{consider_actual_delay};

    $delay = $self->_add_jitter($delay)
        if $self->{jitter_factor};

    # keep between max(0, min_delay) and max_delay
    $delay = $self->{max_delay}
        if defined $self->{max_delay} && $delay > $self->{max_delay};
    $delay = 0 if $delay < 0;
    $delay = $self->{min_delay}
        if defined $self->{min_delay} && $delay < $self->{min_delay};

    $self->{_last_timestamp} = $timestamp;
    $self->{_prev_delay}     = $delay;
    $delay;
}

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

    $timestamp //= time();

    $self->{_attempts} = 0;

    $self->_success_or_failure(1, $timestamp);
}

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

    $timestamp //= time();

    return -1 if defined $self->{max_actual_duration} &&
        $self->{max_actual_duration} > 0 &&
        $timestamp - $self->{_start_timestamp} >= $self->{max_actual_duration};

    $self->{_attempts}++;
    return -1 if $self->{max_attempts} &&
        $self->{_attempts} >= $self->{max_attempts};

    $self->_success_or_failure(0, $timestamp);
}

1;
# ABSTRACT: Various backoff strategies for retry

__END__

=pod

=encoding UTF-8

=head1 NAME

Algorithm::Backoff - Various backoff strategies for retry

=head1 VERSION

This document describes version 0.010 of Algorithm::Backoff (from Perl distribution Algorithm-Backoff), released on 2024-02-24.

=head1 SYNOPSIS

 # 1. pick a strategy and instantiate

 use Algorithm::Backoff::Constant;
 my $ab = Algorithm::Backoff::Constant->new(
     delay             => 2, # required
     #delay_on_success => 0, # optional, default 0
 );

 # 2. log success/failure and get a new number of seconds to delay. if you don't
 # want to log for the current time, you can pass a timestamp (number of seconds
 # passed since some reference value, like a Unix epoch) as the argument, which
 # should be monotonically increasing.

 my $secs = $ab->failure(); # => 2
 my $secs = $ab->success(); # => 0
 my $secs = $ab->failure(); # => 2

=head1 DESCRIPTION

This distribution provides several classes that implement various backoff
strategies for setting delay between retry attempts.

This class (C<Algorithm::Backoff>) is a base class only.

Algorithm::Backoff does not actually provide a function/method to retry a piece
of code. It only contains the backoff strategies and splits the actual delaying
to another module (e.g. L<Retry::Backoff>). This allows for things like
printing/returning all the retries and their delay amounts without actually
doing the delay (e.g. in L<show-backoff-delays> script).

=head1 METHODS