Files to try out the problem and potential solutions to https://stackoverflow.com/questions/55752813/

tx_exec.pl

#!/usr/bin/perl

use strict; # make sure $PWD is in your PERL5LIB
# no warnings!

use tx_exec qw(tx_exec);

tx_exec ("normal", sub { return "foobar"; });
tx_exec ("die", sub { die "barbaz\n"; });
tx_exec ("last", sub { last; });
tx_exec ("next", sub { next; });

tx_exec.pm (fatal warnings)

package tx_exec;

use strict;
use warnings;

require Exporter;
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(tx_exec);

my $MAX_TRIES = 3;

sub tx_exec {
    my ($desc, $sub, $args) = @_;
    print "\ntx_exec($desc):\n";
    my $try = 0;
    while (1) {
        $try++;
        my $sub_ret;
        my $ok = eval {
            use warnings FATAL => qw(exiting);
            # start transaction
            { $sub_ret = $sub->($args); }
            print "sub returned properly\n";
            # commit transaction
            1;
        };
        unless ($ok) {
            print "failed with error: $@";
            # rollback transaction
            if ($try >= $MAX_TRIES) {
                print "failed after $try tries\n";
                return (undef, undef);
            }
            print "try #$try failed, retrying...\n";
            next;
        }
        # some cleanup
        print "returning (1, ".($sub_ret//'<undef>').")\n";
        return (1, $sub_ret);
    }
    print "should never reach this\n";
}

tx_exec.pm (local $SIG)

package tx_exec;

use strict;
use warnings;

require Exporter;
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(tx_exec);

my $MAX_TRIES = 3;

sub tx_exec {
    my ($desc, $sub, $args) = @_;
    print "\ntx_exec($desc):\n";
    my $try = 0;
    while (1) {
        $try++;
        my $sub_ret;
        my $ok = eval {
            local $SIG{__WARN__} = sub {
                die @_ if $_[0] =~ /^Exiting subroutine via (?:last|next)/;
                warn @_;
            };

            # start transaction
            $sub_ret = $sub->($args);
            # commit transaction
            1;
        };
        unless ($ok) {
            print "failed with error: $@";
            # rollback transaction
            if ($try >= $MAX_TRIES) {
                print "failed after $try tries\n";
                return (undef, undef);
            }
            print "try #$try failed, retrying...\n";
            next;
        }
        # some cleanup
        print "returning (1, ".($sub_ret//'<undef>').")\n";
        return (1, $sub_ret);
    }
    print "should never reach this\n";
}

tx_exec.pm (manual detection)

package tx_exec;

use strict;
use warnings;

require Exporter;
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(tx_exec);

my $MAX_TRIES = 3;

sub tx_exec {
    my ($desc, $sub, $args) = @_;
    print "\ntx_exec($desc):\n";
    my $try = 0;
    my $running = 0;
    while (1) {
        $try++;
        my $sub_ret;
        my $ok = eval {
            # start transaction
            die "Usage of `next` disallowed in closure passed to tx_exec\n" if $running;
            $running = 1;
            $sub_ret = $sub->($args);
            print "sub returned properly\n";
            # commit transaction
            1;
        };

        $running = 0;

        unless ($ok) {
            if ($@ =~ /^Usage of `next`/) {
                print $@;
                return (undef, undef); # don't retry
            }
            print "failed with error: $@";
            # rollback transaction
            if ($try >= $MAX_TRIES) {
                print "failed after $try tries\n";
                return (undef, undef);
            }
            print "try #$try failed, retrying...\n";
            next;
        }
        # some cleanup
        print "returning (1, ".($sub_ret//'<undef>').")\n";
        return (1, $sub_ret);
    }
    print "Usage of `last` disallowed in closure passed to tx_exec\n";
    return (undef, undef);
}

tx_exec.pm (ysth's bare block)

package tx_exec;

use strict;
use warnings;

require Exporter;
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(tx_exec);

my $MAX_TRIES = 3;

sub tx_exec {
    my ($desc, $sub, $args) = @_;
    print "\ntx_exec($desc):\n";
    my $try = 0;
    while (1) {
        $try++;
        my $sub_ret;
        my $ok = eval {
            # start transaction
            my $proper_return = 0;
            {
                $sub_ret = $sub->($args);
                $proper_return = 1;
                print "sub returned properly\n";
            }
            die "Usage of `next` or `last` disallowed in closure passed to tx_exec\n" unless $proper_return;
            # commit transaction
            1;
        };

        unless ($ok) {
            if ($@ =~ /^Usage of `next`/) {
                print $@;
                return (undef, undef); # don't retry
            }
            print "failed with error: $@";
            # rollback transaction
            if ($try >= $MAX_TRIES) {
                print "failed after $try tries\n";
                return (undef, undef);
            }
            print "try #$try failed, retrying...\n";
            next;
        }
        # some cleanup
        print "returning (1, ".($sub_ret//'<undef>').")\n";
        return (1, $sub_ret);
    }
    print "Usage of `last` disallowed in closure passed to tx_exec\n";
    return (undef, undef);
}