ErrorHandler.pm
上传用户:market2
上传日期:2018-11-18
资源大小:18786k
文件大小:5k
- #########################################################################
- # OpenKore - Default error handler
- #
- # Copyright (c) 2006 OpenKore Development Team
- #
- # This software is open source, licensed under the GNU General Public
- # License, version 2.
- # Basically, this means that you're allowed to modify and distribute
- # this software. However, if you distribute modified versions, you MUST
- # also distribute the source code.
- # See http://www.gnu.org/licenses/gpl.html for the full license.
- #########################################################################
- ##
- # MODULE DESCRIPTION: Default error handler.
- #
- # This module displays a nice error dialog to the user if the program crashes
- # unexpectedly.
- #
- # To use this feature, simply type 'use ErrorHandler'.
- package ErrorHandler;
- use strict;
- use Carp;
- use Scalar::Util;
- use encoding 'utf8';
- sub T {
- if (defined &Translation::T && defined &Translation::_translate) {
- return &Translation::T;
- } else {
- return $_[0];
- }
- }
- sub TF {
- if (defined &Translation::TF && defined &Translation::T && defined &Translation::_translate) {
- return &Translation::TF;
- } else {
- my $format = shift;
- return sprintf($format, @_);
- }
- }
- sub showError {
- if (!$Globals::interface || UNIVERSAL::isa($Globals::interface, "Interface::Startup") || UNIVERSAL::isa($Globals::interface, "Interface::Socket")) {
- print TF("%snPress ENTER to exit this program.n", $_[0]);
- <STDIN>;
- } else {
- $Globals::interface->errorDialog($_[0]);
- }
- }
- sub errorHandler {
- return unless (defined $^S && $^S == 0);
- my $e = $_[0];
- # Get the error message, and extract file and line number.
- my ($file, $line, $errorMessage);
- if (UNIVERSAL::isa($e, 'Exception::Class::Base')) {
- $file = $e->file;
- $line = $e->line;
- $errorMessage = $e->message;
- } else {
- ($file, $line) = $e =~ / at (.+?) line (d+).$/;
- # Get rid of the annoying "@INC contains:"
- $errorMessage = $e;
- $errorMessage =~ s/ (@INC contains: .*)//;
- }
- $errorMessage =~ s/[rn]+$//s;
- # Create the message to be displayed to the user.
- my $display = TF("This program has encountered an unexpected problem. This is probably becausen" .
- "of a recent server update, a bug in this program, or in one of the plugins.n" .
- "We apologize for this problem. You may get support from IRC or the forums.nn" .
- "A detailed error report has been saved to errors.txt. Before posting a bugn" .
- "report, please try out the SVN version first. If you are already using the SVNn" .
- "version, search the forums first to see if your problem had already been solved,n" .
- "or has already been reported. If you truly believe you have encountered a bug inn" .
- "the program, please include the contents of the errors.txt in your bug report,n" .
- "or we may not be able to help you!nn" .
- "The error message is:n" .
- "%s",
- $errorMessage);
- # Create the errors.txt error log.
- my $log = '';
- $log .= "$Settings::NAME version ${Settings::VERSION}${Settings::SVN}n" if (defined $Settings::VERSION);
- $log .= "@ai_seq = @Globals::ai_seqn" if (defined @Globals::ai_seq);
- $log .= "Network state = $Globals::conStaten" if (defined $Globals::conState);
- $log .= "Network handler = " . Scalar::Util::blessed($Globals::net) . "n" if ($Globals::net);
- my $revision = defined(&Settings::getSVNRevision) ? Settings::getSVNRevision() : undef;
- if (defined $revision) {
- $log .= "SVN revision: $revisionn";
- } else {
- $log .= "SVN revision: unknownn";
- }
- if (defined @Plugins::plugins) {
- $log .= "Loaded plugins:n";
- foreach my $plugin (@Plugins::plugins) {
- next if (!defined $plugin);
- $log .= " $plugin->{filename} ($plugin->{name})n";
- }
- } else {
- $log .= "No loaded plugins.n";
- }
- $log .= "nError message:n$errorMessagenn";
- # Add stack trace to errors.txt.
- if (UNIVERSAL::isa($e, 'Exception::Class::Base')) {
- $log .= "Stack trace:n";
- $log .= $e->trace();
- } elsif (defined &Carp::longmess) {
- $log .= "Stack trace:n";
- my $e = $errorMessage;
- $log .= Carp::longmess("$en");
- }
- $log =~ s/n+$//s;
- # Find out which line died.
- if (defined $file && defined $line && -f $file && open(F, "<", $file)) {
- my @lines = <F>;
- close F;
- my $msg;
- $msg .= " $lines[$line-2]" if ($line - 2 >= 0);
- $msg .= "* $lines[$line-1]";
- $msg .= " $lines[$line]" if (@lines > $line);
- $msg .= "n" unless $msg =~ /n$/s;
- $log .= TF("nnDied at this line:n%sn", $msg);
- }
- if (open(F, ">:utf8", "errors.txt")) {
- print F $log;
- close F;
- }
- showError($display);
- exit 9;
- }
- $SIG{__DIE__} = &errorHandler;
- 1;