ErrorHandler.pm
上传用户:market2
上传日期:2018-11-18
资源大小:18786k
文件大小:5k
源码类别:

外挂编程

开发平台:

Windows_Unix

  1. #########################################################################
  2. #  OpenKore - Default error handler
  3. #
  4. #  Copyright (c) 2006 OpenKore Development Team
  5. #
  6. #  This software is open source, licensed under the GNU General Public
  7. #  License, version 2.
  8. #  Basically, this means that you're allowed to modify and distribute
  9. #  this software. However, if you distribute modified versions, you MUST
  10. #  also distribute the source code.
  11. #  See http://www.gnu.org/licenses/gpl.html for the full license.
  12. #########################################################################
  13. ##
  14. # MODULE DESCRIPTION: Default error handler.
  15. #
  16. # This module displays a nice error dialog to the user if the program crashes
  17. # unexpectedly.
  18. #
  19. # To use this feature, simply type 'use ErrorHandler'.
  20. package ErrorHandler;
  21. use strict;
  22. use Carp;
  23. use Scalar::Util;
  24. use encoding 'utf8';
  25. sub T {
  26. if (defined &Translation::T && defined &Translation::_translate) {
  27. return &Translation::T;
  28. } else {
  29. return $_[0];
  30. }
  31. }
  32. sub TF {
  33. if (defined &Translation::TF && defined &Translation::T && defined &Translation::_translate) {
  34. return &Translation::TF;
  35. } else {
  36. my $format = shift;
  37. return sprintf($format, @_);
  38. }
  39. }
  40. sub showError {
  41. if (!$Globals::interface || UNIVERSAL::isa($Globals::interface, "Interface::Startup") || UNIVERSAL::isa($Globals::interface, "Interface::Socket")) {
  42. print TF("%snPress ENTER to exit this program.n", $_[0]);
  43. <STDIN>;
  44. } else {
  45. $Globals::interface->errorDialog($_[0]);
  46. }
  47. }
  48. sub errorHandler {
  49. return unless (defined $^S && $^S == 0);
  50. my $e = $_[0];
  51. # Get the error message, and extract file and line number.
  52. my ($file, $line, $errorMessage);
  53. if (UNIVERSAL::isa($e, 'Exception::Class::Base')) {
  54. $file = $e->file;
  55. $line = $e->line;
  56. $errorMessage = $e->message;
  57. } else {
  58. ($file, $line) = $e =~ / at (.+?) line (d+).$/;
  59. # Get rid of the annoying "@INC contains:"
  60. $errorMessage = $e;
  61. $errorMessage =~ s/ (@INC contains: .*)//;
  62. }
  63. $errorMessage =~ s/[rn]+$//s;
  64. # Create the message to be displayed to the user.
  65. my $display = TF("This program has encountered an unexpected problem. This is probably becausen" .
  66.                  "of a recent server update, a bug in this program, or in one of the plugins.n" .
  67.                  "We apologize for this problem. You may get support from IRC or the forums.nn" .
  68.                  "A detailed error report has been saved to errors.txt. Before posting a bugn" . 
  69.                  "report, please try out the SVN version first. If you are already using the SVNn" . 
  70.                  "version, search the forums first to see if your problem had already been solved,n" . 
  71.                  "or has already been reported. If you truly believe you have encountered a bug inn" .
  72.                  "the program, please include the contents of the errors.txt in your bug report,n" .
  73.  "or we may not be able to help you!nn" .
  74.                  "The error message is:n" .
  75.                  "%s",
  76.                  $errorMessage);
  77. # Create the errors.txt error log.
  78. my $log = '';
  79. $log .= "$Settings::NAME version ${Settings::VERSION}${Settings::SVN}n" if (defined $Settings::VERSION);
  80. $log .= "@ai_seq = @Globals::ai_seqn" if (defined @Globals::ai_seq);
  81. $log .= "Network state = $Globals::conStaten" if (defined $Globals::conState);
  82. $log .= "Network handler = " . Scalar::Util::blessed($Globals::net) . "n" if ($Globals::net);
  83. my $revision = defined(&Settings::getSVNRevision) ? Settings::getSVNRevision() : undef;
  84. if (defined $revision) {
  85. $log .= "SVN revision: $revisionn";
  86. } else {
  87. $log .= "SVN revision: unknownn";
  88. }
  89. if (defined @Plugins::plugins) {
  90. $log .= "Loaded plugins:n";
  91. foreach my $plugin (@Plugins::plugins) {
  92. next if (!defined $plugin);
  93. $log .= "  $plugin->{filename} ($plugin->{name})n";
  94. }
  95. } else {
  96. $log .= "No loaded plugins.n";
  97. }
  98. $log .= "nError message:n$errorMessagenn";
  99. # Add stack trace to errors.txt.
  100. if (UNIVERSAL::isa($e, 'Exception::Class::Base')) {
  101. $log .= "Stack trace:n";
  102. $log .= $e->trace();
  103. } elsif (defined &Carp::longmess) {
  104. $log .= "Stack trace:n";
  105. my $e = $errorMessage;
  106. $log .= Carp::longmess("$en");
  107. }
  108. $log =~ s/n+$//s;
  109. # Find out which line died.
  110. if (defined $file && defined $line && -f $file && open(F, "<", $file)) {
  111. my @lines = <F>;
  112. close F;
  113. my $msg;
  114. $msg .=  "  $lines[$line-2]" if ($line - 2 >= 0);
  115. $msg .= "* $lines[$line-1]";
  116. $msg .= "  $lines[$line]" if (@lines > $line);
  117. $msg .= "n" unless $msg =~ /n$/s;
  118. $log .= TF("nnDied at this line:n%sn", $msg);
  119. }
  120. if (open(F, ">:utf8", "errors.txt")) {
  121. print F $log;
  122. close F;
  123. }
  124. showError($display);
  125. exit 9;
  126. }
  127. $SIG{__DIE__} = &errorHandler;
  128. 1;