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

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

sub outer { middle() }

sub middle {
    eval { inner() };
    if ( my $x = $@ ) { # 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 sub:

use Devel::StackTrace;

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

[редактировать: я сделал ошибку, код выше на самом деле не работать так, как я хочу, он фактически обходит обработку исключений middle sub. Поэтому я думаю, что вопрос действительно должен быть: возможно ли поведение, которое я хочу?]

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

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

12
eval perl stack-trace

3 ответов

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

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

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

outer();

sub outer { middle(@_) }

sub middle { eval { inner() }; die $@ if $@ }

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(). (Вы не в своем примере, ваш фактический код может отличаться.)

в вашем примере вы пытаетесь вернуть данные через $@. Ты не можешь этого сделать. Использовать 

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

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

8

обновление: Я изменил код, чтобы переопределить 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 = $@ ) { # caught exception
        if (ref $x eq 'ARRAY') {
            print "we can handle this ...";
        }
        else {
            die $x; # rethrow
        }
    }
}

sub inner { die "OH NOES!" }
10

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

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

4