Bug Fixing 1782 patch
[koha.git] / C4 / Context.pm
index 361b6dc..e81fd95 100644 (file)
@@ -22,35 +22,53 @@ use vars qw($VERSION $AUTOLOAD $context @context_stack);
 BEGIN {
        if ($ENV{'HTTP_USER_AGENT'})    {
                require CGI::Carp;
+        # FIXME for future reference, CGI::Carp doc says
+        #  "Note that fatalsToBrowser does not work with mod_perl version 2.0 and higher."
                import CGI::Carp qw(fatalsToBrowser);
                        sub handle_errors {
                                my $msg = shift;
                                my $debug_level =  C4::Context->preference("DebugLevel");
 
+                print q(<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
+                            "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
+                       <html lang="en" xml:lang="en"  xmlns="http://www.w3.org/1999/xhtml">
+                       <head><title>Koha Error</title></head>
+                       <body>
+                );
                                if ($debug_level eq "2"){
                                        # debug 2 , print extra info too.
                                        my %versions = get_versions();
 
                # a little example table with various version info";
                                        print "
-                                               <h1>debug level $debug_level </h1>
-                                               <p>Got an error: $msg</p>
+                                               <h1>Koha error</h1>
+                                               <p>The following fatal error has occurred:</p> 
+                        <pre><code>$msg</code></pre>
                                                <table>
-                                               <tr><th>Apache<td>  $versions{apacheVersion}</tr>
-                                               <tr><th>Koha<td>    $versions{kohaVersion}</tr>
-                                               <tr><th>MySQL<td>   $versions{mysqlVersion}</tr>
-                                               <tr><th>OS<td>      $versions{osVersion}</tr>
-                                               <tr><th>Perl<td>    $versions{perlVersion}</tr>
+                                               <tr><th>Apache</th><td>  $versions{apacheVersion}</td></tr>
+                                               <tr><th>Koha</th><td>    $versions{kohaVersion}</td></tr>
+                                               <tr><th>Koha DB</th><td> $versions{kohaDbVersion}</td></tr>
+                                               <tr><th>MySQL</th><td>   $versions{mysqlVersion}</td></tr>
+                                               <tr><th>OS</th><td>      $versions{osVersion}</td></tr>
+                                               <tr><th>Perl</th><td>    $versions{perlVersion}</td></tr>
                                                </table>";
 
                                } elsif ($debug_level eq "1"){
-                                       print "<h1>debug level $debug_level </h1>";
-                                       print "<p>Got an error: $msg</p>";
+                                       print "
+                                               <h1>Koha error</h1>
+                                               <p>The following fatal error has occurred:</p> 
+                        <pre><code>$msg</code></pre>";
                                } else {
-                                       print "production mode - trapped fatal";
+                                       print "<p>production mode - trapped fatal error</p>";
                                }       
-                       }       
-               CGI::Carp->set_message(\&handle_errors);
+                print "</body></html>";
+                       }
+               CGI::Carp::set_message(\&handle_errors);
+               ## give a stack backtrace if KOHA_BACKTRACES is set
+               ## can't rely on DebugLevel for this, as we're not yet connected
+               if ($ENV{KOHA_BACKTRACES}) {
+                       $main::SIG{__DIE__} = \&CGI::Carp::confess;
+               }
     }          # else there is no browser to send fatals to!
        $VERSION = '3.00.00.036';
 }
@@ -263,19 +281,19 @@ sub new {
 
     # check that the specified config file exists and is not empty
     undef $conf_fname unless 
-        (defined $conf_fname && -e $conf_fname && -s $conf_fname);
+        (defined $conf_fname && -s $conf_fname);
     # Figure out a good config file to load if none was specified.
     if (!defined($conf_fname))
     {
         # If the $KOHA_CONF environment variable is set, use
         # that. Otherwise, use the built-in default.
-        if (exists $ENV{"KOHA_CONF"} and $ENV{'KOHA_CONF'} and -e  $ENV{"KOHA_CONF"} and -s  $ENV{"KOHA_CONF"}) {
+        if (exists $ENV{"KOHA_CONF"} and $ENV{'KOHA_CONF'} and -s  $ENV{"KOHA_CONF"}) {
             $conf_fname = $ENV{"KOHA_CONF"};
-        } elsif ($INSTALLED_CONFIG_FNAME !~ /__KOHA_CONF_DIR/ and -e $INSTALLED_CONFIG_FNAME and -s $INSTALLED_CONFIG_FNAME) {
+        } elsif ($INSTALLED_CONFIG_FNAME !~ /__KOHA_CONF_DIR/ and -s $INSTALLED_CONFIG_FNAME) {
             # NOTE: be careful -- don't change __KOHA_CONF_DIR in the above
             # regex to anything else -- don't want installer to rewrite it
             $conf_fname = $INSTALLED_CONFIG_FNAME;
-        } elsif (-e CONFIG_FNAME and -s CONFIG_FNAME) {
+        } elsif (-s CONFIG_FNAME) {
             $conf_fname = CONFIG_FNAME;
         } else {
             warn "unable to locate Koha configuration file koha-conf.xml";
@@ -494,10 +512,18 @@ sub Zconn {
     my $auth=shift;
     my $piggyback=shift;
     my $syntax=shift;
-    if ( defined($context->{"Zconn"}->{$server}) ) {
+    if ( defined($context->{"Zconn"}->{$server}) && (0 == $context->{"Zconn"}->{$server}->errcode()) ) {
         return $context->{"Zconn"}->{$server};
     # No connection object or it died. Create one.
     }else {
+        # release resources if we're closing a connection and making a new one
+        # FIXME: this needs to be smarter -- an error due to a malformed query or
+        # a missing index does not necessarily require us to close the connection
+        # and make a new one, particularly for a batch job.  However, at
+        # first glance it does not look like there's a way to easily check
+        # the basic health of a ZOOM::Connection
+        $context->{"Zconn"}->{$server}->destroy() if defined($context->{"Zconn"}->{$server});
+
         $context->{"Zconn"}->{$server} = &_new_Zconn($server,$async,$auth,$piggyback,$syntax);
         return $context->{"Zconn"}->{$server};
     }
@@ -942,7 +968,8 @@ Gets various version info, for core Koha packages, Currently called from carp ha
 # A little example sub to show more debugging info for CGI::Carp
 sub get_versions {
     my %versions;
-    $versions{kohaVersion}  = C4::Context->config("kohaversion");
+    $versions{kohaVersion}  = KOHAVERSION();
+    $versions{kohaDbVersion} = C4::Context->preference('version');
     $versions{osVersion} = `uname -a`;
     $versions{perlVersion} = $];
     $versions{mysqlVersion} = `mysql -V`;