fixed typo in 018 DB change

[koha_fer] / C4 / Context.pm

diff --git a/C4/Context.pm b/C4/Context.pm
index e762aa5..d238d97 100644 (file)
--- a/C4/Context.pm
+++ b/C4/Context.pm
@@ -16,20 +16,53 @@ package C4::Context;
 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
 # Suite 330, Boston, MA  02111-1307 USA
 
-# $Id$
 use strict;
+use Data::Dumper;
+
+BEGIN {
+       if ($ENV{'HTTP_USER_AGENT'})    {
+               require CGI::Carp;
+               import CGI::Carp qw(fatalsToBrowser);
+                       sub handle_errors {
+                               my $msg = shift;
+                               my $debug_level =  C4::Context->preference("DebugLevel");
+
+                               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>
+                                               <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>
+                                               </table>";
+
+                               } elsif ($debug_level eq "1"){
+                                       print "<h1>debug level $debug_level </h1>";
+                                       print "<p>Got an error: $msg</p>";
+                               } else {
+                                       print "production mode - trapped fatal";
+                               }       
+                       }       
+               CGI::Carp->set_message(\&handle_errors);
+    }          # else there is no browser to send fatals to!
+}
+
 use DBI;
 use ZOOM;
 use XML::Simple;
 
 use C4::Boolean;
 
-use vars qw($VERSION $AUTOLOAD),
-    qw($context),
-    qw(@context_stack);
+use vars qw($VERSION $AUTOLOAD $context @context_stack);
 
-$VERSION = do { my @v = '$Revision$' =~ /\d+/g;
-        shift(@v) . "." . join("_", map {sprintf "%03d", $_ } @v); };
+$VERSION = '3.00.00.005';
 
 =head1 NAME
 
@@ -113,9 +146,16 @@ $context = undef;        # Initially, no context is set
 
 sub KOHAVERSION {
     my $cgidir = C4::Context->intranetdir ."/cgi-bin";
+
+    # 2 cases here : on CVS install, $cgidir does not need a /cgi-bin
+    # on a standard install, /cgi-bin need to be added.
+    # test one, then the other
+    # FIXME - is this all really necessary?
     unless (opendir(DIR, "$cgidir/cataloguing/value_builder")) {
-            $cgidir = C4::Context->intranetdir;
+        $cgidir = C4::Context->intranetdir;
+        closedir(DIR);
     }
+
     do $cgidir."/kohaversion.pl" || die "NO $cgidir/kohaversion.pl";
     return kohaversion();
 }
@@ -384,10 +424,7 @@ sub preference
     my $self = shift;
     my $var = shift;        # The system preference to return
     my $retval;            # Return value
-    my $dbh = C4::Context->dbh;    # Database handle
-    if ($dbh){
-    my $sth;            # Database query handle
-
+    my $dbh = C4::Context->dbh or return 0;
     # Look up systempreferences.variable==$var
     $retval = $dbh->selectrow_array(<<EOT);
         SELECT    value
@@ -396,9 +433,6 @@ sub preference
         LIMIT    1
 EOT
     return $retval;
-    } else {
-      return 0
-    }
 }
 
 sub boolean_preference ($) {
@@ -804,7 +838,7 @@ set_userenv is called in Auth.pm
 
 #'
 sub set_userenv{
-    my ($usernum, $userid, $usercnum, $userfirstname, $usersurname, $userbranch, $branchname, $userflags, $emailaddress)= @_;
+    my ($usernum, $userid, $usercnum, $userfirstname, $usersurname, $userbranch, $branchname, $userflags, $emailaddress, $branchprinter)= @_;
     my $var=$context->{"activeuser"};
     my $cell = {
         "number"     => $usernum,
@@ -817,6 +851,7 @@ sub set_userenv{
         "branchname" => $branchname,
         "flags"      => $userflags,
         "emailaddress"    => $emailaddress,
+               "branchprinter"    => $branchprinter
     };
     $context->{userenv}->{$var} = $cell;
     return $cell;
@@ -860,6 +895,30 @@ sub _unset_userenv
 }
 
 
+=item get_versions
+
+  C4::Context->get_versions
+
+Gets various version info, for core Koha packages, Currently called from carp handle_errors() sub, to send to browser if 'DebugLevel' syspref is set to '2'.
+
+=cut
+
+#'
+
+# A little example sub to show more debugging info for CGI::Carp
+sub get_versions {
+    my %versions;
+    $versions{kohaVersion}  = C4::Context->config("kohaversion");
+    $versions{osVersion} = `uname -a`;
+    $versions{perlVersion} = $];
+    $versions{mysqlVersion} = `mysql -V`;
+    $versions{apacheVersion} =  `httpd -v`;
+    $versions{apacheVersion} =  `httpd2 -v`            unless  $versions{apacheVersion} ;
+    $versions{apacheVersion} =  `apache2 -v`           unless  $versions{apacheVersion} ;
+    $versions{apacheVersion} =  `/usr/sbin/apache2 -v` unless  $versions{apacheVersion} ;
+    return %versions;
+}
+
 
 1;
 __END__
@@ -886,7 +945,6 @@ Joshua Ferraro <jmf at liblime dot com>
 
 =cut
 
-# $Log$
 # Revision 1.57  2007/05/22 09:13:55  tipaul
 # Bugfixes & improvements (various and minor) :
 # - updating templates to have tmpl_process3.pl running without any errors