分页: 1 / 1

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

发表于 : 2023年03月06日 09:02
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++; } }; }

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 可以做同样的调整,可以在崩溃之前执行相应的数据保存、日志输出操作。