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__在outersub中安装一个本地化的处理程序:

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();
}

[ 编辑:我犯了一个错误,上面的代码实际上没有按照我想要的方式工作,它实际上绕过了middlesub 的异常处理.所以我想问题应该是:我想要的行为甚至可能吗？]

这非常有效唯一的问题是,如果我理解正确的文档,它依赖于明确弃用的行为,即__DIE__即使是die"s"内部的eval { }"s " 触发处理程序的事实,他们实际上不应该这样做.无论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(@_) };

代替.(我假设这只是一个错误,简化代码足以在这里发布.)