[原创代码] [Perl]warning 信息定制 - 向上追溯调用者的函数名以及行号

523066680

use utf8;
use Encode;
use Modern::Perl;
STDOUT->autoflush(1);
 
warn "";
major( );
 
sub major
{
    primary();   
}
 
sub primary 
{
    warning();
}
 
sub warning
{
    warn gbk(sprintf("中文测试 %s", "abc"));
}
 
sub gbk { encode('gbk', $_[0]) }
sub utf8 { encode('utf8', $_[0]) }
sub u2gbk { encode('gbk', decode('utf8', $_[0])) }
sub uni { decode('utf8', $_[0]) }
 
 
BEGIN 
{
    $SIG{__WARN__} = sub {
        state %WARNS;
        my $message = shift;
        $message =~ s/(?:something's wrong)? at (?:[A-Z]:.*?)([^\\\/]+)( line \d+)/ at $1$2/i;
 
        # 计数器，避免同样的信息重复显示
        return if $WARNS{$message}++;
        printf "%s\n", $message;
 
        my $n = 1;
        while ( caller($n) )
        {
            printf "%s() Line: %d\n", (caller($n))[3,2];
            $n++;
        }
    };
}COPY

warning 信息输出：

Warning:  at warning.pl line 9.

中文测试 abc at warning.pl line 24.

main::warning() Line: 19
main::primary() Line: 14
main::major() Line: 10

die 可以做同样的调整，可以在崩溃之前执行相应的数据保存、日志输出操作。