Perl: $SIG { DIE}, eval {} и трассировка стека

У меня есть часть кода Perl, несколько похожая на следующую (сильно упрощенную): Есть несколько уровней вложенных вызовов подпрограмм (фактически, методы), а некоторые из внутренних выполняют свою обработку исключений:

sub outer { middle() }

sub middle {
    eval { inner() };
    if ( my $x = [email protected] ) { # caught exception
        if (ref $x eq 'ARRAY') {
            print "we can handle this ...";
        }
        else {
            die $x; # rethrow
        }
    }
}

sub inner { die "OH NOES!" }

Теперь я хочу изменить этот код, чтобы он выполнял следующее:

распечатать полную трассировку стека для каждого исключения, которое "пузырится" до самого внешнего уровня (sub outer). В частности, трассировка стека должна не останавливаться на первом уровне "eval { }".
Не нужно изменять реализацию любого из внутренних уровней.

Прямо сейчас, как я это делаю, нужно установить локализованный обработчик __DIE__ внутри outer:

use Devel::StackTrace;

sub outer {
    local $SIG{__DIE__} = sub {
        my $error = shift;
        my $trace = Devel::StackTrace->new;
        print "Error: $error\n",
              "Stack Trace:\n",
              $trace->as_string;
    };
    middle();
}

[ РЕДАКТИРОВАТЬ: я допустил ошибку, код на самом деле не работает так, как я хочу, он фактически обходит обработку исключений под middle sub. Поэтому я думаю, что вопрос действительно должен быть: возможно ли поведение, которое я хочу, возможно?]

~~Это прекрасно работает~~, единственная проблема заключается в том, что, если я правильно понимаю документы, он полагается на поведение, которое явно не рекомендуется, а именно тот факт, что обработчики __DIE__ запускаются даже для "die" внутри "eval { }" s, чего они действительно не должны. Оба perlvar и perlsub указывают, что это поведение может быть удалено в будущих версиях Perl.

Есть ли другой способ, которым я могу достичь этого, не полагаясь на устаревшее поведение, или он сохраняет, чтобы полагаться, даже если документы говорят иначе?

Ответ 1

Небезопасно полагаться на что-либо, о чем говорится в документации, не рекомендуется. Поведение может (и, вероятно, будет) изменяться в будущей версии. Опираясь на устаревшее поведение, вы блокируете вас в версии Perl, которую вы используете сегодня.

К сожалению, я не вижу пути, который соответствует вашим критериям. "Правильное" решение состоит в том, чтобы изменить внутренние методы для вызова Carp::confess вместо die и отказаться от пользовательского обработчика $SIG{__DIE__}.

use strict;
use warnings;
use Carp qw'confess';

outer();

sub outer { middle(@_) }

sub middle { eval { inner() }; die [email protected] if [email protected] }

sub inner { confess("OH NOES!") }
__END__
OH NOES! at c:\temp\foo.pl line 11
    main::inner() called at c:\temp\foo.pl line 9
    eval {...} called at c:\temp\foo.pl line 9
    main::middle() called at c:\temp\foo.pl line 7
    main::outer() called at c:\temp\foo.pl line 5

Так как вы все равно умираете, вам может не потребоваться захватить вызов inner(). (Вы не в своем примере, ваш фактический код может отличаться.)

В вашем примере вы пытаетесь вернуть данные через [email protected]. Вы не можете этого сделать. Используйте

my $x = eval { inner(@_) };

вместо этого. (Я предполагаю, что это просто ошибка в упрощении кода, достаточного для публикации здесь.)

Ответ 2

ОБНОВЛЕНИЕ: Я изменил код, чтобы переопределить die глобально, чтобы также можно было исключить исключения из других пакетов.

Выполняет ли то, что вы хотите?

#!/usr/bin/perl

use strict;
use warnings;

use Devel::StackTrace;

use ex::override GLOBAL_die => sub {
    local *__ANON__ = "custom_die";
    warn (
        'Error: ', @_, "\n",
        "Stack trace:\n",
        Devel::StackTrace->new(no_refs => 1)->as_string, "\n",
    );
    exit 1;
};

use M; # dummy module to functions dying in other modules

outer();

sub outer {
    middle( @_ );
    M::n(); # M::n dies
}

sub middle {
    eval { inner(@_) };
    if ( my $x = [email protected] ) { # caught exception
        if (ref $x eq 'ARRAY') {
            print "we can handle this ...";
        }
        else {
            die $x; # rethrow
        }
    }
}

sub inner { die "OH NOES!" }

Ответ 3

Обратите внимание, что переопределение die будет фиксировать только фактические вызовы die, а не ошибки Perl, такие как разыменование undef.

Я не думаю, что общий случай возможен; вся точка eval - это использование ошибок. Вы МОЖЕТЕ быть в состоянии полагаться на устаревшее поведение именно по этой причине: нет другого способа сделать это в данный момент. Но я не могу найти разумный способ получить трассировку стека в каждом случае без потенциального нарушения любого кода обработки ошибок, который уже существует, но далеко от стека.