如何通过最后/下一步强制退出perl子例程/闭包，使程序自动失败？
考虑到以下功能齐全的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/ like将退出闭包子程序时，我可以强制程序自动/死/死吗？
- 传递的
$sub是一个闭包，而不是一个简单的函数(一个简单的函数无论如何都会死在裸next/last上，这很容易处理) - 库代码(
tx_exec)和客户端代码(调用它)位于单独的编译单元中，客户机不使用警告。
使用perl 5.16.2 (不可能升级)。
下面是一个github gist文档，它记录了到目前为止的所有方法：
use warnings FATAL => qw(exiting)在库代码中没有什么区别- 如果调用站点没有启用
local $SIG警告，则FATAL => qw(exiting)处理程序无法工作 - 手动检测工作，但有点麻烦，到处都是(非本地化)
- ysth使用裸块的方法效果最好，因为它捕获最后一个/下一个，完全本地化手动检测，并确保不会出错(除了next/ labels，这更容易避免)。
回答 2
Stack Overflow用户
发布于 2019-04-21 22:01:08
由于@ysth没有参与写答案，我写的是迄今为止我找到的最好的解决方案，这是他从评论到问题的第一次尝试的启发。(我将重新接受ysth的回答，如果他稍后发布的话)。
调用coderef的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;
};bare块充当一个循环，它将立即在next或last上退出，因此无论是在裸块之后还是在其中，从调用coderef的过程中，我们都可以推断出coderef是否执行了next/last并采取了适当的行动。
更多关于裸块语义及其与next/last的交互的信息可以找到这里。
它作为一个练习留给读者来处理上面代码中很少看到的redo。
Stack Overflow用户
发布于 2019-04-19 08:25:04
这就是我在问题中提到的手工方法。到目前为止，这是唯一的方法，帮助我干净地处理错误的客户端代码，没有任何假设或期望。
如果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_exechttps://stackoverflow.com/questions/55752813
复制相似问题
腾讯云开发者
Copyright © 2013 - 2026 Tencent Cloud. All Rights Reserved. 腾讯云 版权所有
深圳市腾讯计算机系统有限公司 ICP备案/许可证号：粤B2-20090059 
粤公网安备44030502008569号
腾讯云计算（北京）有限责任公司 京ICP证150476号 | 京ICP备11018762号