标题: [原创代码] [Perl]warning 信息定制 - 向上追溯调用者的函数名以及行号 [打印本页]
作者: 523066680 时间: 2023-3-5 08:54 标题: [Perl]warning 信息定制 - 向上追溯调用者的函数名以及行号
本帖最后由 523066680 于 2023-3-5 09:02 编辑
- 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 可以做同样的调整,可以在崩溃之前执行相应的数据保存、日志输出操作。
欢迎光临 批处理之家 (http://bbs.bathome.net/) |
Powered by Discuz! 7.2 |