|
Lines 21-94
use Modern::Perl;
Link Here
|
| 21 |
|
21 |
|
| 22 |
use vars qw($AUTOLOAD $context @context_stack); |
22 |
use vars qw($AUTOLOAD $context @context_stack); |
| 23 |
BEGIN { |
23 |
BEGIN { |
| 24 |
if ($ENV{'HTTP_USER_AGENT'}) { |
24 |
if ( $ENV{'HTTP_USER_AGENT'} ) { # Only hit when plack is not enabled |
| 25 |
require CGI::Carp; |
|
|
| 26 |
# FIXME for future reference, CGI::Carp doc says |
| 27 |
# "Note that fatalsToBrowser does not work with mod_perl version 2.0 and higher." |
| 28 |
import CGI::Carp qw(fatalsToBrowser); |
| 29 |
sub handle_errors { |
| 30 |
my $msg = shift; |
| 31 |
my $debug_level; |
| 32 |
eval {C4::Context->dbh();}; |
| 33 |
if ($@){ |
| 34 |
$debug_level = 1; |
| 35 |
} |
| 36 |
else { |
| 37 |
$debug_level = C4::Context->preference("DebugLevel"); |
| 38 |
} |
| 39 |
|
| 40 |
print q(<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" |
| 41 |
"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> |
| 42 |
<html lang="en" xml:lang="en" xmlns="http://www.w3.org/1999/xhtml"> |
| 43 |
<head><title>Koha Error</title></head> |
| 44 |
<body> |
| 45 |
); |
| 46 |
if ($debug_level eq "2"){ |
| 47 |
# debug 2 , print extra info too. |
| 48 |
my %versions = get_versions(); |
| 49 |
|
| 50 |
# a little example table with various version info"; |
| 51 |
print " |
| 52 |
<h1>Koha error</h1> |
| 53 |
<p>The following fatal error has occurred:</p> |
| 54 |
<pre><code>$msg</code></pre> |
| 55 |
<table> |
| 56 |
<tr><th>Apache</th><td> $versions{apacheVersion}</td></tr> |
| 57 |
<tr><th>Koha</th><td> $versions{kohaVersion}</td></tr> |
| 58 |
<tr><th>Koha DB</th><td> $versions{kohaDbVersion}</td></tr> |
| 59 |
<tr><th>MySQL</th><td> $versions{mysqlVersion}</td></tr> |
| 60 |
<tr><th>OS</th><td> $versions{osVersion}</td></tr> |
| 61 |
<tr><th>Perl</th><td> $versions{perlVersion}</td></tr> |
| 62 |
</table>"; |
| 63 |
|
| 64 |
} elsif ($debug_level eq "1"){ |
| 65 |
print " |
| 66 |
<h1>Koha error</h1> |
| 67 |
<p>The following fatal error has occurred:</p> |
| 68 |
<pre><code>$msg</code></pre>"; |
| 69 |
} else { |
| 70 |
print "<p>production mode - trapped fatal error</p>"; |
| 71 |
} |
| 72 |
print "</body></html>"; |
| 73 |
} |
| 74 |
#CGI::Carp::set_message(\&handle_errors); |
| 75 |
## give a stack backtrace if KOHA_BACKTRACES is set |
| 76 |
## can't rely on DebugLevel for this, as we're not yet connected |
| 77 |
if ($ENV{KOHA_BACKTRACES}) { |
| 78 |
$main::SIG{__DIE__} = \&CGI::Carp::confess; |
| 79 |
} |
| 80 |
|
25 |
|
| 81 |
# Redefine multi_param if cgi version is < 4.08 |
26 |
# Redefine multi_param if cgi version is < 4.08 |
| 82 |
# Remove the "CGI::param called in list context" warning in this case |
27 |
# Remove the "CGI::param called in list context" warning in this case |
| 83 |
require CGI; # Can't check version without the require. |
28 |
require CGI; # Can't check version without the require. |
| 84 |
if (!defined($CGI::VERSION) || $CGI::VERSION < 4.08) { |
29 |
if ( !defined($CGI::VERSION) || $CGI::VERSION < 4.08 ) { |
| 85 |
no warnings 'redefine'; |
30 |
no warnings 'redefine'; |
| 86 |
*CGI::multi_param = \&CGI::param; |
31 |
*CGI::multi_param = \&CGI::param; |
| 87 |
use warnings 'redefine'; |
32 |
use warnings 'redefine'; |
| 88 |
$CGI::LIST_CONTEXT_WARN = 0; |
33 |
$CGI::LIST_CONTEXT_WARN = 0; |
| 89 |
} |
34 |
} |
| 90 |
} # else there is no browser to send fatals to! |
35 |
} |
| 91 |
} |
36 |
}; |
| 92 |
|
37 |
|
| 93 |
use Carp; |
38 |
use Carp; |
| 94 |
use DateTime::TimeZone; |
39 |
use DateTime::TimeZone; |
| 95 |
- |
|
|