X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=C4%2FContext.pm;h=2f2bc96c17635ecc584d6d0f9d8868bb3244dc0f;hb=b6e62489d8dc749db077ccb86ea29f4ae7b91fa6;hp=7813f498a3b4eb06a226c85b1d810431e4f765b7;hpb=f721d43fd969e998dd7a14c918f43e328a170ee1;p=koha.git

diff --git a/C4/Context.pm b/C4/Context.pm
index 7813f498a3..2f2bc96c17 100644
--- a/C4/Context.pm
+++ b/C4/Context.pm
@@ -17,6 +17,7 @@ package C4::Context;
 # Suite 330, Boston, MA  02111-1307 USA
 
 use strict;
+use warnings;
 use vars qw($VERSION $AUTOLOAD $context @context_stack);
 
 BEGIN {
@@ -85,6 +86,7 @@ use ZOOM;
 use XML::Simple;
 use C4::Boolean;
 use C4::Debug;
+use POSIX ();
 
 =head1 NAME
 
@@ -190,17 +192,14 @@ $context = undef;        # Initially, no context is set
 =cut
 
 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;
-        closedir(DIR);
-    }
+    my $cgidir = C4::Context->intranetdir;
 
+    # Apparently the GIT code does not run out of a CGI-BIN subdirectory
+    # but distribution code does?  (Stan, 1jan08)
+    if(-d $cgidir . "/cgi-bin"){
+        my $cgidir .= "/cgi-bin";
+    }
+    
     do $cgidir."/kohaversion.pl" || die "NO $cgidir/kohaversion.pl";
     return kohaversion();
 }
@@ -461,12 +460,19 @@ with this method.
 
 =cut
 
-# FIXME - The preferences aren't likely to change over the lifetime of
-# the script (and things might break if they did change), so perhaps
-# this function should cache the results it finds.
+# FIXME: running this under mod_perl will require a means of
+# flushing the caching mechanism.
+
+my %sysprefs;
+
 sub preference {
     my $self = shift;
     my $var  = shift;                          # The system preference to return
+
+    if (exists $sysprefs{$var}) {
+        return $sysprefs{$var};
+    }
+
     my $dbh  = C4::Context->dbh or return 0;
 
     # Look up systempreferences.variable==$var
@@ -476,8 +482,8 @@ sub preference {
         WHERE    variable=?
         LIMIT    1
 END_SQL
-    my $retval = $dbh->selectrow_array( $sql, {}, $var );
-    return $retval;
+    $sysprefs{$var} = $dbh->selectrow_array( $sql, {}, $var );
+    return $sysprefs{$var};
 }
 
 sub boolean_preference ($) {
@@ -487,6 +493,20 @@ sub boolean_preference ($) {
     return defined($it)? C4::Boolean::true_p($it): undef;
 }
 
+=item clear_syspref_cache
+
+  C4::Context->clear_syspref_cache();
+
+  cleans the internal cache of sysprefs. Please call this method if
+  you update the systempreferences table. Otherwise, your new changes
+  will not be seen by this process.
+
+=cut
+
+sub clear_syspref_cache {
+    %sysprefs = ();
+}
+
 # AUTOLOAD
 # This implements C4::Config->foo, and simply returns
 # C4::Context->config("foo"), as described in the documentation for
@@ -628,13 +648,13 @@ sub _new_Zconn {
 sub _new_dbh
 {
 
-### $context
-    ##correct name for db_schme        
+    ## $context
+    ## correct name for db_schme        
     my $db_driver;
     if ($context->config("db_scheme")){
-    $db_driver=db_scheme2dbi($context->config("db_scheme"));
+        $db_driver=db_scheme2dbi($context->config("db_scheme"));
     }else{
-    $db_driver="mysql";
+        $db_driver="mysql";
     }
 
     my $db_name   = $context->config("database");
@@ -681,9 +701,8 @@ sub dbh
     my $self = shift;
     my $sth;
 
-    if (defined($context->{"dbh"})) {
-        $sth=$context->{"dbh"}->prepare("select 1");
-        return $context->{"dbh"} if (defined($sth->execute));
+    if (defined($context->{"dbh"}) && $context->{"dbh"}->ping()) {
+	return $context->{"dbh"};
     }
 
     # No database handle or it died . Create one.
@@ -871,7 +890,7 @@ set_userenv is called in Auth.pm
 sub userenv
 {
     my $var = $context->{"activeuser"};
-    return $context->{"userenv"}->{$var} if (defined $context->{"userenv"}->{$var});
+    return $context->{"userenv"}->{$var} if (defined $var and defined $context->{"userenv"}->{$var});
     # insecure=1 management
     if ($context->{"dbh"} && $context->preference('insecure')) {
         my %insecure;
@@ -884,7 +903,7 @@ sub userenv
         $insecure{emailaddress} = 'test@mode.insecure.com';
         return \%insecure;
     } else {
-        return 0;
+        return;
     }
 }
 
@@ -911,12 +930,12 @@ sub set_userenv{
         "cardnumber" => $usercnum,
         "firstname"  => $userfirstname,
         "surname"    => $usersurname,
-#possibly a law problem
+        #possibly a law problem
         "branch"     => $userbranch,
         "branchname" => $branchname,
         "flags"      => $userflags,
-        "emailaddress"    => $emailaddress,
-		"branchprinter"    => $branchprinter
+        "emailaddress"     => $emailaddress,
+        "branchprinter"    => $branchprinter
     };
     $context->{userenv}->{$var} = $cell;
     return $cell;
@@ -995,13 +1014,16 @@ sub get_versions {
     my %versions;
     $versions{kohaVersion}  = KOHAVERSION();
     $versions{kohaDbVersion} = C4::Context->preference('version');
-    $versions{osVersion} = `uname -a`;
+    $versions{osVersion} = join(" ", POSIX::uname());
     $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} ;
+    {
+        no warnings qw(exec); # suppress warnings if unable to find a program in $PATH
+        $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;
 }