MT 1816: Granular permissions for the serials module

[koha.git] / C4 / Context.pm

diff --git a/C4/Context.pm b/C4/Context.pm
index e3be714..4dab9a9 100644 (file)
--- 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();
 }
@@ -494,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
@@ -635,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");
@@ -853,7 +866,6 @@ sub _new_stopwords
     my $sth = $dbh->prepare("select word from stopwords");
     $sth->execute;
     while (my $stopword = $sth->fetchrow_array) {
-        my $retval = {};
         $stopwordlist->{$stopword} = uc($stopword);
     }
     $stopwordlist->{A} = "A" unless $stopwordlist;
@@ -864,20 +876,17 @@ sub _new_stopwords
 
   C4::Context->userenv;
 
-Builds a hash for user environment variables.
+Retrieves a hash for user environment variables.
 
 This hash shall be cached for future use: if you call
 C<C4::Context-E<gt>userenv> twice, you will get the same hash without real DB access
 
-set_userenv is called in Auth.pm
-
 =cut
 
 #'
-sub userenv
-{
+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;
@@ -890,7 +899,7 @@ sub userenv
         $insecure{emailaddress} = 'test@mode.insecure.com';
         return \%insecure;
     } else {
-        return 0;
+        return;
     }
 }
 
@@ -898,17 +907,14 @@ sub userenv
 
   C4::Context->set_userenv($usernum, $userid, $usercnum, $userfirstname, $usersurname, $userbranch, $userflags, $emailaddress);
 
-Informs a hash for user environment variables.
-
-This hash shall be cached for future use: if you call
-C<C4::Context-E<gt>userenv> twice, you will get the same hash without real DB access
+Establish a hash of user environment variables.
 
 set_userenv is called in Auth.pm
 
 =cut
 
 #'
-sub set_userenv{
+sub set_userenv {
     my ($usernum, $userid, $usercnum, $userfirstname, $usersurname, $userbranch, $branchname, $userflags, $emailaddress, $branchprinter)= @_;
     my $var=$context->{"activeuser"};
     my $cell = {
@@ -917,12 +923,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;
@@ -950,7 +956,7 @@ sub get_shelves_userenv () {
 
 =item _new_userenv
 
-  C4::Context->_new_userenv($session);
+  C4::Context->_new_userenv($session);  # FIXME: This calling style is wrong for what looks like an _internal function
 
 Builds a hash for user environment variables.
 
@@ -964,7 +970,7 @@ _new_userenv is called in Auth.pm
 #'
 sub _new_userenv
 {
-    shift;
+    shift;  # Useless except it compensates for bad calling style
     my ($sessionID)= @_;
      $context->{"activeuser"}=$sessionID;
 }
@@ -1001,13 +1007,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;
 }