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!" }

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

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

• 无需更改任何内层的实现。

现在，我这样做的方法是在__DIE__ sub中安装本地化的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();
}

[编辑：我犯了一个错误，上面的代码实际上没有以我想要的方式工作，它实际上绕过了{{1}的异常处理} sub。所以我想问题应该是：我想要的行为甚至可能吗？]

这完全可以工作，唯一的问题是，如果我正确理解文档，它依赖于明确弃用的行为，即即使对于middle处理程序被触发的事实“__DIE__”里面的“die”，他们真的不应该这样。 eval { }和perlvar都声明在将来的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，而非 Perl错误，例如解除引用undef。

我认为一般情况不可能; eval的整个要点是消耗错误。您可能完全依赖于已弃用的行为：目前没有其他方法可以做到这一点。但是我无法找到任何合理的方法来获取堆栈跟踪，而不会破坏堆栈中已存在的任何错误处理代码。