Perl：强制堆栈跟踪“无法调用未定义的方法”

Question

我使用 Perl 和 Catalyst 作为 Web 框架。

如果抛出像 Can't call method "XXX" on an undefined value... 这样的异常，我如何全局强制堆栈跟踪？

假设您的Controller/Root.pm中有以下代码

use DateTime;

sub test  :Local :Args(0) {
    my ( $self, $c ) = @_;
    my $now = DateTime->now(time_zone=>'local');
    my $tmp = undef;

    my $throwing = $tmp - $now; #this will throw an exception!
    $c->res->body("OK");
}

打开http://localhost:3000/test当然会抛出异常：

在 MyApp::Controller::Root->test 中捕获异常“无法调用方法 未定义值的“subtract_datetime” /usr/local/lib/perl/5.10.1/DateTime.pm 第 1619 行，第 1003 行。”

堆栈跟踪丢失！

在这种情况下如何强制执行堆栈跟踪？

即我想得到（不是真正的输出，只能手工组成）：

MyApp::Controller::Root::__ANON__('Can\'t call method "subtract_datetime" on an undefined value at /usr/local/lib/perl/5.10.1/DateTime.pm line 1619, <DATA> line 1003.^J') called at /home/user/MyApp/script/../lib/MyApp/Controller/Root.pm line 114
MyApp::Controller::Root::test('MyApp::Controller::Root=HASH(0x20583b60)', 'MyApp=HASH(0x206e9140)') called at /usr/local/share/perl/5.10.1/Catalyst/Action.pm line 65
Catalyst::Action::execute('Catalyst::Action=HASH(0x20668e88)', 'MyApp::Controller::Root=HASH(0x20583b60)', 'MyApp=HASH(0x206e9140)') called at /usr/local/share/perl/5.10.1/Catalyst.pm line 1687
eval {...} at /usr/local/share/perl/5.10.1/Catalyst.pm line 1687
Catalyst::execute('MyApp=HASH(0x206e9140)', 'MyApp::Controller::Root', 'Catalyst::Action=HASH(0x20668e88)') called at /usr/local/share/perl/5.10.1/Catalyst/Action.pm line 60
[ and the rest of the exception ...]

这样我就知道异常是由 Root.pm 中的第 114 行引起的

Answer 1

我不确定它是否在 Catalyst 中工作，但通常你可以通过包含 CPAN 模块 Carp::Always 来强制堆栈跟踪，例如通过在程序中的某处写入use Carp::Always; 或使用-MCarp::Always 开关启动perl 脚本。

Answer 2

一种解决方案是替换 __DIE__ 和 __WARN__ 的默认信号处理程序：

use Carp;
$SIG{__DIE__} = sub { die Carp::longmess @_ };
$SIG{__WARN__} = sub { warn Carp::longmess @_ };

这基本上就是Carp::Always 为您所做的（但它更彻底、更安全）。

如果您只在代码的一部分中关心这一点，那么使用动态范围来限制效果：

#!/usr/bin/perl

use strict;
use warnings;

use Carp;

warn "not affected 1";

foo();
bar("outside");

warn "not affected 2";

sub foo {
    local $SIG{__WARN__} = sub { warn Carp::longmess @_ };
    warn "in foo";
    bar("inside");
}

sub bar {
    warn @_;
}

输出：

not affected 1 at t.pl line 8.
in foo at t.pl line 17.
 at t.pl line 17
    main::foo() called at t.pl line 10
inside at t.pl line 22.
 at t.pl line 22
    main::bar('inside') called at t.pl line 18
    main::foo() called at t.pl line 10
outside at t.pl line 22.
not affected 2 at t.pl line 13.