updated links in README

[koha_fer] / C4 / Context.pm

diff --git a/C4/Context.pm b/C4/Context.pm
index 9c7e0b8..926c1a5 100644 (file)
--- a/C4/Context.pm
+++ b/C4/Context.pm
@@ -12,12 +12,12 @@ package C4::Context;
 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
 #
-# You should have received a copy of the GNU General Public License along with
-# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
-# Suite 330, Boston, MA  02111-1307 USA
+# You should have received a copy of the GNU General Public License along
+# with Koha; if not, write to the Free Software Foundation, Inc.,
+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
 
-use warnings;
 use strict;
+use warnings;
 use vars qw($VERSION $AUTOLOAD $context @context_stack);
 
 BEGIN {
@@ -71,7 +71,7 @@ BEGIN {
                                }       
                 print "</body></html>";
                        }
-               CGI::Carp::set_message(\&handle_errors);
+               #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}) {
@@ -86,6 +86,7 @@ use ZOOM;
 use XML::Simple;
 use C4::Boolean;
 use C4::Debug;
+use POSIX ();
 
 =head1 NAME
 
@@ -232,7 +233,7 @@ Returns undef in case of error.
 =cut
 
 sub read_config_file {         # Pass argument naming config file to read
-    my $koha = XMLin(shift, keyattr => ['id'], forcearray => ['listen', 'server', 'serverinfo']);
+    my $koha = XMLin(shift, keyattr => ['id'], forcearray => ['listen', 'server', 'serverinfo'], suppressempty => '');
     return $koha;                      # Return value: ref-to-hash holding the configuration
 }
 
@@ -506,6 +507,37 @@ sub clear_syspref_cache {
     %sysprefs = ();
 }
 
+=item set_preference
+
+  C4::Context->set_preference( $variable, $value );
+
+  This updates a preference's value both in the systempreferences table and in
+  the sysprefs cache.
+
+=cut
+
+sub set_preference {
+    my $self = shift;
+    my $var = shift;
+    my $value = shift;
+
+    my $dbh = C4::Context->dbh or return 0;
+
+    my $type = $dbh->selectrow_array( "SELECT type FROM systempreferences WHERE variable = ?", {}, $var );
+
+    $value = 0 if ( $type && $type eq 'YesNo' && $value eq '' );
+
+    my $sth = $dbh->prepare( "
+      INSERT INTO systempreferences
+        ( variable, value )
+        VALUES( ?, ? )
+        ON DUPLICATE KEY UPDATE value = VALUES(value)
+    " );
+
+    $sth->execute( $var, $value );
+    $sth->finish;
+}
+
 # AUTOLOAD
 # This implements C4::Config->foo, and simply returns
 # C4::Context->config("foo"), as described in the documentation for
@@ -865,7 +897,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;
@@ -876,20 +907,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;
@@ -902,7 +930,7 @@ sub userenv
         $insecure{emailaddress} = 'test@mode.insecure.com';
         return \%insecure;
     } else {
-        return 0;
+        return;
     }
 }
 
@@ -910,17 +938,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 = {
@@ -962,7 +987,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.
 
@@ -976,7 +1001,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;
 }
@@ -1013,13 +1038,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;
 }