[新手上路]批处理新手入门导读[视频教程]批处理基础视频教程[视频教程]VBS基础视频教程[批处理精品]批处理版照片整理器
[批处理精品]纯批处理备份&还原驱动[批处理精品]CMD命令50条不能说的秘密[在线下载]第三方命令行工具[在线帮助]VBScript / JScript 在线参考
返回列表 发帖

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

本帖最后由 523066680 于 2023-3-5 09:02 编辑
  1. use utf8;
  2. use Encode;
  3. use Modern::Perl;
  4. STDOUT->autoflush(1);
  5. warn "";
  6. major( );
  7. sub major
  8. {
  9.     primary();   
  10. }
  11. sub primary
  12. {
  13.     warning();
  14. }
  15. sub warning
  16. {
  17.     warn gbk(sprintf("中文测试 %s", "abc"));
  18. }
  19. sub gbk { encode('gbk', $_[0]) }
  20. sub utf8 { encode('utf8', $_[0]) }
  21. sub u2gbk { encode('gbk', decode('utf8', $_[0])) }
  22. sub uni { decode('utf8', $_[0]) }
  23. BEGIN
  24. {
  25.     $SIG{__WARN__} = sub {
  26.         state %WARNS;
  27.         my $message = shift;
  28.         $message =~ s/(?:something's wrong)? at (?:[A-Z]:.*?)([^\\\/]+)( line \d+)/ at $1$2/i;
  29.         # 计数器,避免同样的信息重复显示
  30.         return if $WARNS{$message}++;
  31.         printf "%s\n", $message;
  32.         my $n = 1;
  33.         while ( caller($n) )
  34.         {
  35.             printf "%s() Line: %d\n", (caller($n))[3,2];
  36.             $n++;
  37.         }
  38.     };
  39. }
复制代码
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 可以做同样的调整,可以在崩溃之前执行相应的数据保存、日志输出操作。

返回列表