Perl：$SIG{__DIE__}、eval { } 和堆栈跟踪

Question

我有一段 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!" }

现在我想更改该代码，以便它执行以下操作：

• 为每个一直“冒泡”到最外层（subouter）的异常打印完整的堆栈跟踪。 具体来说，堆栈跟踪不应停止在“eval { }”的第一级。

• 不必更改任何内部级别的实现。

现在，我执行此操作的方法是在 outer 子内部安装本地化的 __DIE__ 处理程序：

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子的异常处理。 所以我想问题实际上应该是：我想要的行为是否可能？]

这完美地工作，唯一的问题是，如果我正确理解文档，它依赖于明确弃用的行为，即即使“eval { }”内的“die”也会触发 __DIE__ 处理程序，它们确实应该这样做” t。 perlvar 和 perlsub 都声明此行为可能会在 Perl 的未来版本中删除。

有没有另一种方法可以在不依赖已弃用的行为的情况下实现此目的，或者即使文档另有说明，也可以依赖它吗？

Answer 1

更新：我更改了代码以全局覆盖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!" }

Answer 2

依赖文档中指出已弃用的任何内容都是不安全的。 该行为可能（并且可能会）在未来版本中发生变化。 依赖已弃用的行为会将您锁定在当前运行的 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(@_) };

。 （我假设这只是将代码简化到足以将其发布到此处的错误。）

Answer 3

请注意，覆盖 die 只会捕获对 die 的实际调用，不会像解引用 undef 这样的 Perl 错误。

我认为一般情况是不可能的； eval 的全部意义在于消耗错误。 正是出于这个原因，您可能能够依赖已弃用的行为：目前没有其他方法可以做到这一点。 但我找不到任何合理的方法来在每种情况下获取堆栈跟踪，而不会潜在地破坏堆栈中已经存在的任何错误处理代码。