如何强制通过last / next退出perl子例程/关闭程序使程序自动失败？

时间：2019-04-18 19:45:08

标签： perl closures

给出以下功能齐全的perl脚本和模块：

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 ：

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
            $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);
    }
}

我得到以下输出：

$ ./tx_exec.pl
tx_exec(normal):
returning (1, foobar)

tx_exec(die):
failed with error: barbaz
try #1 failed, retrying...
failed with error: barbaz
try #2 failed, retrying...
failed with error: barbaz
failed after 3 tries

tx_exec(last):

tx_exec(next):
# infinite loop

我了解发生了什么，如果我在定义闭包的脚本中打开警告，则会收到有关此情况的警告。但是，在以下严格情况下，当next / last退出此处的闭包子例程时，我是否可以强制程序自动/自然地失败/死：

  • 传递的$sub是一个闭包，而不是一个简单的函数（一个简单的函数死在裸next/last上，这很容易处理）
  • 库代码（tx_exec）和客户端代码（调用它）位于单独的编译单元中，客户端不使用警告。

使用perl 5.16.2（无法升级）。

这是github gist，记录了到目前为止的所有方法：

  • use warnings FATAL => qw(exiting)在库代码中没有任何作用
    • 如果呼叫站点未启用local $SIG警告，
  • FATAL => qw(exiting)处理程序将无法工作
  • 手动检测有效，但在整个地方（非本地化）都有些麻烦
  • ysth的带有裸露块的方法效果最好，因为它捕获了last / next，对本地检测进行了完全本地化，并确保不会出错（带有标签的next / last除外，这更容易避免）。

3 个答案:

答案 0 :(得分：3)

短 如果在子程序中使用next / last（调用者作为coderef传递），则会触发异常（如果不在“循环块中”）。只需更改tx_exec()，就可以轻松处理此类使用。

问题中提出的错误使用last / next有点微妙之处。首先，从last

  

last不能用于退出返回诸如eval {}，sub {}或do {}之类的值的块，并且不应该用于退出{{ 1}}或grep操作。

在子目录或map中执行此操作，我们会收到警告

Exiting subroutine via last at ...

（对于“ eval”），并且对于eval同样。它们在perldiag中被归类为next，可以通过使用/而不使用W编译指示来控制。†这个事实挫败了{ {1}}警告或通过warnings钩。

但是，如果FATAL => 'exiting'或$SIG{__WARN__}（在子目录或next中）的使用在任何封闭范围（或调用堆栈）中没有“循环块”，则它也会引发异常。‡消息是

Can't "last" outside a loop block...

，对于last同样。在perldiag（搜索eval）中找到了，分类为next。

然后，针对此问题的一种解决方案是运行由调用方在循环块之外传递的coderef，我们让解释器进行检查并提醒我们（引发异常）违规使用。由于outside a loop循环只能尝试多次，因此可以实现。

可以在实用程序例程中针对此异常运行并测试coderef 

F

可以像

一样使用 
while (1)

这种方法在设计上很有意义：它允许为不允许的使用引发异常，并将处理方式本地化在自己的子程序中。

仅在第一次运行时才检查不允许的行为，因为在循环之后调用sub run_coderef { my ($sub, @args) = @_; my $sub_ret; my $ok = eval { $sub_ret = $sub->(@args); 1 }; if (not $ok) { if ($@ =~ /^Can't "(?:next|last)"/) { #' die $@; # disallow such use } else { return } # other error, perhaps retry } else { return $sub_ret } } 时，不会抛出（此）异常。这很好，因为重复的运行（针对“允许的”失败）是使用相同的子程序执行的，因此足以检查首次使用。

另一方面，这也意味着我们可以

  • 直接在sub tx_exec { my ($sub, @args) = @_; my $sub_ret = run_coderef($sub, @args); my $run_again = (defined $sub_ret) ? 0 : 1; if ($run_again) { my $MAX_TRIES = 3; my $try = 0; while (1) { ++$try; $sub_ret = run_coderef($sub, @args); if ( not defined $sub_ret ) { # "other error", run again if ($try >= $MAX_TRIES) { print "failed after $try tries\n"; return (undef, undef); } print "try #$try failed, retrying...\n"; next; } ... } } } 中运行run_coderef，因为我们已经检查了第一个eval { $sub_ret = $sub->(@args) ... } / while (1)的错误使用运行

  • 可以添加更多案例以在last中进行检查，使其更加全面。第一个示例是next警告，我们可以将其设为致命警告并进行检查。如果在呼叫者中启用了警告，这将很有用

这种方法 可以被挫败，但是呼叫者将不得不为此而竭尽全力。

经过v5.16.3和v5.26.2的测试。

†顺便说一句，您无法抗拒呼叫者关闭警告的决定。别理他们。这是他们的代码。

‡可以用

检查 
run_coderef

我们到哪里

Exiting subroutine via last at -e line 1.
Can't "last" outside a loop block at -e line

如果有“循环”块

Exiting

我们可以看到程序的结尾，没有例外

Exiting subroutine via last at -e line 1.
done

额外的块perl -wE'sub tt { last }; do { tt() }; say "done"' “ 与执行一次的循环基本相同”（next）。

可以通过在perl -wE'sub tt { last }; { do { tt() } }; say "done"' 中打印其消息来检查{ ... }。

基于仅发出警告的期望的原始帖子

warnings pragma是词法，因此要添加句首注释

eval

子程序本身（或在$@中进行更严格的限定）应该在限制条件下工作

use warnings FATAL => 'exiting';

因为警告在eval范围内触发。在我的测试中，使用未执行代码引用sub tx_exec { use warnings FATAL => "exiting"; my ($sub, $args) = @_; $sub->($args); }; 的调用首先运行良好，并且仅在以后与它们的调用中终止。

或者，可以使用tx_exec "signal" (hook)

实施它 
last/next

答案 1 :(得分：1)

这是我在问题中提到的手动方法。到目前为止，这是唯一可以帮助我在没有任何假设或期望的情况下，干净地处理客户端代码的唯一方法。

我希望并且很乐意考虑使用一种更惯用的方法，例如local $SIG或use warnings FATAL => 'exiting'，如果它们在工作时没有客户的期望代码（特别是它以任何形式启用了警告）。

tx_exec.pl ：

#!/usr/bin/perl

use strict;
# 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 ：

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(normal):
sub returned properly
returning (1, foobar)

tx_exec(die):
failed with error: barbaz
try #1 failed, retrying...
failed with error: barbaz
try #2 failed, retrying...
failed with error: barbaz
failed after 3 tries

tx_exec(last):
Usage of `last` disallowed in closure passed to tx_exec

tx_exec(next):
Usage of `next` disallowed in closure passed to tx_exec

答案 2 :(得分：0)

由于@ysth缺乏编写答案的能力，我正在编写迄今为止找到的最佳解决方案，这是他从评论到问题的首次尝试启发而来的。 （如果他稍后发布，我将重新接受ysth的回答。）

调用代码引用的eval必须看起来像这样：

my $ok = eval {
    # start transaction
    my $proper_return = 0;
    {
        $sub_ret = $sub->($args);
        $proper_return = 1;
    }
    die "Usage of `next` or `last` disallowed in coderef passed to tx_exec\n" unless $proper_return;
    # commit transaction
    1;
};

裸块充当循环，将立即在next或last上退出，因此无论我们是在裸块之后还是在裸块中着陆，都可以通过调用coderef来推断coderef是否执行next/last并采取适当的行动。

可以在here上找到有关裸块语义及其与next/last的交互的更多信息。

这是读者用来处理上面代码中鲜为人知的redo的练习。

相关问题
最新问题