File Coverage

blib/lib/Perinci/Sub/Property/retry.pm

Criterion	Covered	Total	%
statement	56	59	94.9
branch	17	24	70.8
condition	8	13	61.5
subroutine	5	5	100.0
pod			n/a
total	86	101	85.1

package Perinci::Sub::Property::retry;

use 5.010001;
use strict;
use warnings;

use Perinci::Sub::PropertyUtil qw(declare_property);

our $VERSION = '0.08'; # VERSION

declare_property(
    name => 'retry',
    type => 'function',
    schema => ['any' => {default=>0, of=>[
        ['int' => {min=>0, default=>0}],
        ['hash*' => {keys=>{
            'n'     => ['int' => {min=>0, default=>0}],
            'delay' => ['int' => {min=>0, default=>0}],
            'success_statuses'   => ['regex' => {default=>'^(2..|304)$'}],
            'fatal_statuses'     => 'regex',
            'non_fatal_statuses' => 'regex',
            'fatal_messages'     => 'regex',
            'non_fatal_messages' => 'regex',
        }}],
    ]}],
    wrapper => {
        meta => {
            v       => 2,
            # very high, we want to trap errors as early as possible after eval,
            # so we can retry it.
            prio    => 0,
            convert => 1,
        },
        handler => sub {
            my ($self, %args) = @_;

            my $v    = $args{new} // $args{value};
            $v       = {n=>$v} unless ref($v) eq 'HASH';
            $v->{n}                //= 0;
            $v->{delay}            //= 0;
            $v->{success_statuses} //= qr/^(2..|304)$/;

            for my $k (qw/success_statuses
                          fatal_statuses non_fatal_statuses
                          fatal_messages non_fatal_messages/) {
                if (defined($v->{$k}) && ref($v->{$k}) ne 'Regexp') {
                    $v->{$k} = qr/$v->{$k}/;
                }
            }

            return unless $v->{n} > 0;

            $self->select_section('before_eval');
            $self->push_lines(
                '', 'my $_w_retries = 0;',
                'RETRY: while (1) {');
            $self->indent;

            # pass special variable for function to let it know about retries
            $self->select_section('before_call_arg_validation');
            my $args_as = $self->{_meta}{args_as};
            if ($args_as eq 'hash') {
                $self->push_lines('$args{-retries} = $_w_retries;');
            } elsif ($args_as eq 'hashref') {
                $self->push_lines('$args->{-retries} = $_w_retries;');
            }

            $self->select_section('after_eval');
            if ($self->{_arg}{meta}{result_naked}) {
                $self->push_lines('if ($_w_eval_err) {');
            } else {
                $self->push_lines('if ($_w_eval_err || $_w_res->[0] !~ qr/'.
                                      $v->{success_statuses}.'/) {');
            }
            $self->indent;
            if ($v->{fatal_statuses}) {
                $self->_errif('521', '"Can\'t retry (fatal status $_w_res->[0])"',
                              '$_w_res->[0] =~ qr/'.$v->{fatal_statuses}.'/');
            }
            if ($v->{non_fatal_statuses}) {
                $self->_errif(
                    '521', '"Can\'t retry (not non-fatal status $_w_res->[0])"',
                    '$_w_res->[0] !~ qr/'.$v->{non_fatal_statuses}.'/');
            }
            if ($v->{fatal_messages}) {
                $self->_errif(
                    '521', '"Can\'t retry (fatal message: $_w_res->[1])"',
                    '$_w_res->[1] =~ qr/'.$v->{fatal_messages}.'/');
            }
            if ($v->{non_fatal_messages}) {
                $self->_errif(
                    '521', '"Can\'t retry (not non-fatal message $_w_res->[1])"',
                    '$_w_res->[1] !~ qr/'.$v->{non_fatal_messages}.'/');
            }
            $self->_errif('521', '"Maximum retries reached"',
                          '++$_w_retries > '.$v->{n});
            $self->push_lines('sleep '.int($v->{delay}).';')
                if $v->{delay};
            $self->push_lines('next RETRY;');
            $self->unindent;
            $self->push_lines('} else {');
            $self->indent;
            # return information on number of retries performed
            unless ($self->{_meta}{result_naked}) {
                $self->push_lines('if ($_w_retries) {');
                $self->push_lines($self->{_args}{indent} . '$_w_res->[3] //= {};');
                $self->push_lines($self->{_args}{indent} . '$_w_res->[3]{retries}' .
                              ' = $_w_retries;');
                $self->push_lines('}');
            }
            $self->push_lines('last RETRY;');
            $self->unindent;
            $self->push_lines('}');
            $self->unindent;
            $self->push_lines('', '# RETRY', '}', '');
        },
    },
);

1;
# ABSTRACT: Specify automatic retry

__END__