Short Использование next / last в подпрограмме (этот вызывающий объект передается как coderef) вызывает исключение, если оно не находится внутри "блока цикла". Это позволяет легко обрабатывать такое использование с небольшим изменением tx_exec().
Неправильное использование last / next, о котором идет речь в вопросе, немного нюансировано. Сначала от последний
last нельзя использовать для выхода из блока, который возвращает значение, например eval {}, sub {} или do {}, и его нельзя использовать для выхода из операции grep или map.
и для этого в подпрограмме или eval мы получаем предупреждение
Exiting subroutine via last at ...
(и для "eval"), и аналогично для next. Они классифицируются как W в perldiag и могут управляться с использованием / не warnings прагмой. & dagger; Этот факт мешает сделать такое использование смертельным с помощью FATAL => 'exiting' предупреждение или $SIG{__WARN__} крючком.
Однако, если такое использование next или last (в подпрограмме или eval) не имеет "блока цикла" в какой-либо охватывающей области (или стеке вызовов), то это также вызывает исключение . & Dagger; Сообщение
Can't "last" outside a loop block...
и аналогично для next. Он находится в perldiag (поиск по outside a loop), классифицирован как F.
Тогда одно из решений поставленной проблемы состоит в том, чтобы запустить coderef, переданный вызывающей стороной , за пределами блоков цикла , и мы получаем интерпретатор, который проверяет и предупреждает нас (вызывает исключение) использование, вызывающее проблемы. Поскольку цикл while (1) существует только для возможности многократной попытки, это можно реализовать.
Coderef может быть запущен и протестирован с этим исключением в служебной программе
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 при первом запуске
Можно добавить дополнительные случаи для проверки в run_coderef, что делает его более округлым средством проверки / контроля. Первый пример - Exiting предупреждения, которые мы можем сделать фатальными и проверить их. Это будет полезно, если в вызывающей стороне включены предупреждения
Этот подход может быть сорван, но вызывающий должен был бы изо всех сил идти к этому концу.
Протестировано с v5.16.3 и v5.26.2.
& dagger; & thinsp; Кстати, вы не можете бороться с решением вызывающего абонента отключить предупреждения. Пусть они будут. Это их код.
& Dagger; & thinsp; Это можно проверить с помощью
perl -wE'sub tt { last }; do { tt() }; say "done"'
где мы получаем
Exiting subroutine via last at -e line 1.
Can't "last" outside a loop block at -e line
в то время как есть "зацикленный" блок
perl -wE'sub tt { last }; { do { tt() } }; say "done"'
мы видим конец программы, без исключения
Exiting subroutine via last at -e line 1.
done
Дополнительный блок { ... } " семантически идентичен циклу, который выполняется один раз " ( следующий ).
Это можно проверить для eval, напечатав его сообщение в $@.
Исходное сообщение, основанное на ожидании, что будут отправляться только предупреждения
Прагма предупреждений является лексической, поэтому добавьте к каждому комментарию
use warnings FATAL => 'exiting';
в самом сабе (или в eval для более узкого охвата) должно работать с ограничениями
sub tx_exec {
use warnings FATAL => "exiting";
my ($sub, $args) = @_;
$sub->($args);
};
, так как предупреждение срабатывает в области действия tx_exec. В моем тесте вызов этого с coderef, который не выполняет last/next, сначала выполняется нормально, и он умирает только для последующего вызова с ними.
Или, может реализовать это, используя $SIG{__WARN__} «сигнал» (хук)
sub tx_exec {
local $SIG{__WARN__} = sub {
die @_ if $_[0] =~ /^Exiting subroutine via (?:last|next)/;
warn @_
};
my ($sub, $args) = @_;
...
}