X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=C4%2FContext.pm;h=67d31ee94788119266856e543f368caa021e64d3;hb=791fe1bbd7ccf58110fa0da9f751eccb199a6c47;hp=4dab9a98c52211587718fcc947ad96fab7f8b709;hpb=7013085ca56a6081f4e71ec703916fbd9b7161a0;p=koha.git

diff --git a/C4/Context.pm b/C4/Context.pm
index 4dab9a98c5..67d31ee947 100644
--- a/C4/Context.pm
+++ b/C4/Context.pm
@@ -12,13 +12,13 @@ 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 strict;
 use warnings;
-use vars qw($VERSION $AUTOLOAD $context @context_stack);
+use vars qw($VERSION $AUTOLOAD $context @context_stack $servers $memcached $ismemcached);
 
 BEGIN {
 	if ($ENV{'HTTP_USER_AGENT'})	{
@@ -71,14 +71,31 @@ 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}) {
 			$main::SIG{__DIE__} = \&CGI::Carp::confess;
 		}
     }  	# else there is no browser to send fatals to!
-	$VERSION = '3.00.00.036';
+
+    # Check if there are memcached servers set
+    $servers = $ENV{'MEMCACHED_SERVERS'};
+    if ($servers) {
+        # Load required libraries and create the memcached object
+        require Cache::Memcached;
+        $memcached = Cache::Memcached->new({
+        servers => [ $servers ],
+        debug   => 0,
+        compress_threshold => 10_000,
+        expire_time => 600,
+        namespace => $ENV{'MEMCACHED_NAMESPACE'} || 'koha'
+    });
+        # Verify memcached available (set a variable and test the output)
+    $ismemcached = $memcached->set('ismemcached','1');
+    }
+
+    $VERSION = '3.00.00.036';
 }
 
 use DBI;
@@ -87,6 +104,7 @@ use XML::Simple;
 use C4::Boolean;
 use C4::Debug;
 use POSIX ();
+use DateTime::TimeZone;
 
 =head1 NAME
 
@@ -137,8 +155,6 @@ environment variable to the pathname of a configuration file to use.
 
 =head1 METHODS
 
-=over 2
-
 =cut
 
 #'
@@ -186,8 +202,9 @@ $context = undef;        # Initially, no context is set
 @context_stack = ();        # Initially, no saved contexts
 
 
-=item KOHAVERSION
-    returns the kohaversion stored in kohaversion.pl file
+=head2 KOHAVERSION
+
+returns the kohaversion stored in kohaversion.pl file
 
 =cut
 
@@ -203,9 +220,7 @@ sub KOHAVERSION {
     do $cgidir."/kohaversion.pl" || die "NO $cgidir/kohaversion.pl";
     return kohaversion();
 }
-=item read_config_file
-
-=over 4
+=head2 read_config_file
 
 Reads the specified Koha config file. 
 
@@ -228,26 +243,55 @@ The elements nested within the <server> element:
 
 Returns undef in case of error.
 
-=back
-
 =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 => '');
+
+    if ($ismemcached) {
+      $memcached->set('kohaconf',$koha);
+    }
+
     return $koha;			# Return value: ref-to-hash holding the configuration
 }
 
+=head2 ismemcached
+
+Returns the value of the $ismemcached variable (0/1)
+
+=cut
+
+sub ismemcached {
+    return $ismemcached;
+}
+
+=head2 memcached
+
+If $ismemcached is true, returns the $memcache variable.
+Returns undef otherwise
+
+=cut
+
+sub memcached {
+    if ($ismemcached) {
+      return $memcached;
+    } else {
+      return undef;
+    }
+}
+
 # db_scheme2dbi
 # Translates the full text name of a database into de appropiate dbi name
 # 
 sub db_scheme2dbi {
     my $name = shift;
-
+    # for instance, we support only mysql, so don't care checking
+    return "mysql";
     for ($name) {
 # FIXME - Should have other databases. 
-        if (/mysql/i) { return("mysql"); }
+        if (/mysql/) { return("mysql"); }
         if (/Postgres|Pg|PostgresSQL/) { return("Pg"); }
-        if (/oracle/i) { return("Oracle"); }
+        if (/oracle/) { return("Oracle"); }
     }
     return undef;         # Just in case
 }
@@ -270,7 +314,7 @@ sub import {
     1;
 }
 
-=item new
+=head2 new
 
   $context = new C4::Context;
   $context = new C4::Context("/path/to/koha-conf.xml");
@@ -279,6 +323,10 @@ Allocates a new context. Initializes the context from the specified
 file, which defaults to either the file given by the C<$KOHA_CONF>
 environment variable, or F</etc/koha/koha-conf.xml>.
 
+It saves the koha-conf.xml values in the declared memcached server(s)
+if currently available and uses those values until them expire and
+re-reads them.
+
 C<&new> does not set this context as the new default context; for
 that, use C<&set_context>.
 
@@ -313,10 +361,20 @@ sub new {
             return undef;
         }
     }
-        # Load the desired config file.
-    $self = read_config_file($conf_fname);
-    $self->{"config_file"} = $conf_fname;
     
+    if ($ismemcached) {
+        # retreive from memcached
+        $self = $memcached->get('kohaconf');
+        if (not defined $self) {
+            # not in memcached yet
+            $self = read_config_file($conf_fname);
+        }
+    } else {
+        # non-memcached env, read from file
+        $self = read_config_file($conf_fname);
+    }
+
+    $self->{"config_file"} = $conf_fname;
     warn "read_config_file($conf_fname) returned undef" if !defined($self->{"config"});
     return undef if !defined($self->{"config"});
 
@@ -327,12 +385,13 @@ sub new {
     $self->{"userenv"} = undef;        # User env
     $self->{"activeuser"} = undef;        # current active user
     $self->{"shelves"} = undef;
+    $self->{tz} = undef; # local timezone object
 
     bless $self, $class;
     return $self;
 }
 
-=item set_context
+=head2 set_context
 
   $context = new C4::Context;
   $context->set_context();
@@ -380,7 +439,7 @@ sub set_context
     $context = $new_context;
 }
 
-=item restore_context
+=head2 restore_context
 
   &restore_context;
 
@@ -406,7 +465,7 @@ sub restore_context
     # that was current when this was called?
 }
 
-=item config
+=head2 config
 
   $value = C4::Context->config("config_variable");
 
@@ -444,7 +503,7 @@ sub ModZebrations {
 	return _common_config($_[1],'serverinfo');
 }
 
-=item preference
+=head2 preference
 
   $sys_preference = C4::Context->preference('some_variable');
 
@@ -467,7 +526,7 @@ my %sysprefs;
 
 sub preference {
     my $self = shift;
-    my $var  = shift;                          # The system preference to return
+    my $var  = lc(shift);                          # The system preference to return
 
     if (exists $sysprefs{$var}) {
         return $sysprefs{$var};
@@ -493,13 +552,13 @@ sub boolean_preference ($) {
     return defined($it)? C4::Boolean::true_p($it): undef;
 }
 
-=item clear_syspref_cache
+=head2 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.
+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
 
@@ -507,6 +566,39 @@ sub clear_syspref_cache {
     %sysprefs = ();
 }
 
+=head2 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 = lc(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)
+    " );
+
+    if($sth->execute( $var, $value )) {
+        $sysprefs{$var} = $value;
+    }
+    $sth->finish;
+}
+
 # AUTOLOAD
 # This implements C4::Config->foo, and simply returns
 # C4::Context->config("foo"), as described in the documentation for
@@ -525,9 +617,9 @@ sub AUTOLOAD
     return $self->config($AUTOLOAD);
 }
 
-=item Zconn
+=head2 Zconn
 
-$Zconn = C4::Context->Zconn
+  $Zconn = C4::Context->Zconn
 
 Returns a connection to the Zebra database for the current
 context. If no connection has yet been made, this method 
@@ -568,7 +660,7 @@ sub Zconn {
     }
 }
 
-=item _new_Zconn
+=head2 _new_Zconn
 
 $context->{"Zconn"} = &_new_Zconn($server,$async);
 
@@ -664,7 +756,7 @@ sub _new_dbh
     my $db_passwd = $context->config("pass");
     # MJR added or die here, as we can't work without dbh
     my $dbh= DBI->connect("DBI:$db_driver:dbname=$db_name;host=$db_host;port=$db_port",
-	$db_user, $db_passwd) or die $DBI::errstr;
+    $db_user, $db_passwd, {'RaiseError' => $ENV{DEBUG}?1:0 }) or die $DBI::errstr;
 	my $tz = $ENV{TZ};
     if ( $db_driver eq 'mysql' ) { 
         # Koha 3.0 is utf-8, so force utf8 communication between mySQL and koha, whatever the mysql default config.
@@ -680,7 +772,7 @@ sub _new_dbh
     return $dbh;
 }
 
-=item dbh
+=head2 dbh
 
   $dbh = C4::Context->dbh;
 
@@ -711,7 +803,7 @@ sub dbh
     return $context->{"dbh"};
 }
 
-=item new_dbh
+=head2 new_dbh
 
   $dbh = C4::Context->new_dbh;
 
@@ -732,7 +824,7 @@ sub new_dbh
     return &_new_dbh();
 }
 
-=item set_dbh
+=head2 set_dbh
 
   $my_dbh = C4::Connect->new_dbh;
   C4::Connect->set_dbh($my_dbh);
@@ -763,7 +855,7 @@ sub set_dbh
     $context->{"dbh"} = $new_dbh;
 }
 
-=item restore_dbh
+=head2 restore_dbh
 
   C4::Context->restore_dbh;
 
@@ -790,7 +882,7 @@ sub restore_dbh
     # return something, then this function should, too.
 }
 
-=item marcfromkohafield
+=head2 marcfromkohafield
 
   $dbh = C4::Context->marcfromkohafield;
 
@@ -831,7 +923,7 @@ sub _new_marcfromkohafield
     return $marcfromkohafield;
 }
 
-=item stopwords
+=head2 stopwords
 
   $dbh = C4::Context->stopwords;
 
@@ -872,7 +964,7 @@ sub _new_stopwords
     return $stopwordlist;
 }
 
-=item userenv
+=head2 userenv
 
   C4::Context->userenv;
 
@@ -888,7 +980,7 @@ sub userenv {
     my $var = $context->{"activeuser"};
     return $context->{"userenv"}->{$var} if (defined $var and defined $context->{"userenv"}->{$var});
     # insecure=1 management
-    if ($context->{"dbh"} && $context->preference('insecure')) {
+    if ($context->{"dbh"} && $context->preference('insecure') eq 'yes') {
         my %insecure;
         $insecure{flags} = '16382';
         $insecure{branchname} ='Insecure';
@@ -903,9 +995,10 @@ sub userenv {
     }
 }
 
-=item set_userenv
+=head2 set_userenv
 
-  C4::Context->set_userenv($usernum, $userid, $usercnum, $userfirstname, $usersurname, $userbranch, $userflags, $emailaddress);
+  C4::Context->set_userenv($usernum, $userid, $usercnum, $userfirstname, 
+                  $usersurname, $userbranch, $userflags, $emailaddress);
 
 Establish a hash of user environment variables.
 
@@ -954,7 +1047,7 @@ sub get_shelves_userenv () {
 	return ($totshelves, $pubshelves, $barshelves);
 }
 
-=item _new_userenv
+=head2 _new_userenv
 
   C4::Context->_new_userenv($session);  # FIXME: This calling style is wrong for what looks like an _internal function
 
@@ -975,7 +1068,7 @@ sub _new_userenv
      $context->{"activeuser"}=$sessionID;
 }
 
-=item _unset_userenv
+=head2 _unset_userenv
 
   C4::Context->_unset_userenv;
 
@@ -992,7 +1085,7 @@ sub _unset_userenv
 }
 
 
-=item get_versions
+=head2 get_versions
 
   C4::Context->get_versions
 
@@ -1021,21 +1114,33 @@ sub get_versions {
 }
 
 
+=head2 tz
+
+  C4::Context->tz
+
+  Returns a DateTime::TimeZone object for the system timezone
+
+=cut
+
+sub tz {
+    my $self = shift;
+    if (!defined $context->{tz}) {
+        $context->{tz} = DateTime::TimeZone->new(name => 'local');
+    }
+    return $context->{tz};
+}
+
+
+
 1;
 __END__
 
-=back
-
 =head1 ENVIRONMENT
 
-=over 4
-
-=item C<KOHA_CONF>
+=head2 C<KOHA_CONF>
 
 Specifies the configuration file to read.
 
-=back
-
 =head1 SEE ALSO
 
 XML::Simple
@@ -1047,217 +1152,3 @@ Andrew Arensburger <arensb at ooblick dot com>
 Joshua Ferraro <jmf at liblime dot com>
 
 =cut
-
-# 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
-# - adding a drupal-like css for prog templates (with 3 small images)
-# - fixing some bugs in circulation & other scripts
-# - updating french translation
-# - fixing some typos in templates
-#
-# Revision 1.56  2007/04/23 15:21:17  tipaul
-# renaming currenttransfers to transferstoreceive
-#
-# Revision 1.55  2007/04/17 08:48:00  tipaul
-# circulation cleaning continued: bufixing
-#
-# Revision 1.54  2007/03/29 16:45:53  tipaul
-# Code cleaning of Biblio.pm (continued)
-#
-# All subs have be cleaned :
-# - removed useless
-# - merged some
-# - reordering Biblio.pm completly
-# - using only naming conventions
-#
-# Seems to have broken nothing, but it still has to be heavily tested.
-# Note that Biblio.pm is now much more efficient than previously & probably more reliable as well.
-#
-# Revision 1.53  2007/03/29 13:30:31  tipaul
-# Code cleaning :
-# == Biblio.pm cleaning (useless) ==
-# * some sub declaration dropped
-# * removed modbiblio sub
-# * removed moditem sub
-# * removed newitems. It was used only in finishrecieve. Replaced by a TransformKohaToMarc+AddItem, that is better.
-# * removed MARCkoha2marcItem
-# * removed MARCdelsubfield declaration
-# * removed MARCkoha2marcBiblio
-#
-# == Biblio.pm cleaning (naming conventions) ==
-# * MARCgettagslib renamed to GetMarcStructure
-# * MARCgetitems renamed to GetMarcItem
-# * MARCfind_frameworkcode renamed to GetFrameworkCode
-# * MARCmarc2koha renamed to TransformMarcToKoha
-# * MARChtml2marc renamed to TransformHtmlToMarc
-# * MARChtml2xml renamed to TranformeHtmlToXml
-# * zebraop renamed to ModZebra
-#
-# == MARC=OFF ==
-# * removing MARC=OFF related scripts (in cataloguing directory)
-# * removed checkitems (function related to MARC=off feature, that is completly broken in head. If someone want to reintroduce it, hard work coming...)
-# * removed getitemsbybiblioitem (used only by MARC=OFF scripts, that is removed as well)
-#
-# Revision 1.52  2007/03/16 01:25:08  kados
-# Using my precrash CVS copy I did the following:
-#
-# cvs -z3 -d:ext:kados@cvs.savannah.nongnu.org:/sources/koha co -P koha
-# find koha.precrash -type d -name "CVS" -exec rm -v {} \;
-# cp -r koha.precrash/* koha/
-# cd koha/
-# cvs commit
-#
-# This should in theory put us right back where we were before the crash
-#
-# Revision 1.52  2007/03/12 21:17:05  rych
-# add server, serverinfo as arrays from config
-#
-# Revision 1.51  2007/03/09 14:31:47  tipaul
-# rel_3_0 moved to HEAD
-#
-# Revision 1.43.2.10  2007/02/09 17:17:56  hdl
-# Managing a little better database absence.
-# (preventing from BIG 550)
-#
-# Revision 1.43.2.9  2006/12/20 16:50:48  tipaul
-# improving "insecure" management
-#
-# WARNING KADOS :
-# you told me that you had some libraries with insecure=ON (behind a firewall).
-# In this commit, I created a "fake" user when insecure=ON. It has a fake branch. You may find better to have the 1st branch in branch table instead of a fake one.
-#
-# Revision 1.43.2.8  2006/12/19 16:48:16  alaurin
-# reident programs, and adding branchcode value in reserves
-#
-# Revision 1.43.2.7  2006/12/06 21:55:38  hdl
-# Adding ModZebrations for servers to get serverinfos in Context.pm
-# Using this function in rebuild_zebra.pl
-#
-# Revision 1.43.2.6  2006/11/24 21:18:31  kados
-# very minor changes, no functional ones, just comments, etc.
-#
-# Revision 1.43.2.5  2006/10/30 13:24:16  toins
-# fix some minor POD error.
-#
-# Revision 1.43.2.4  2006/10/12 21:42:49  hdl
-# Managing multiple zebra connections
-#
-# Revision 1.43.2.3  2006/10/11 14:27:26  tipaul
-# removing a warning
-#
-# Revision 1.43.2.2  2006/10/10 15:28:16  hdl
-# BUG FIXING : using database name in Zconn if defined and not hard coded value
-#
-# Revision 1.43.2.1  2006/10/06 13:47:28  toins
-# Synch with dev_week.
-#  /!\ WARNING :: Please now use the new version of koha.xml.
-#
-# Revision 1.18.2.5.2.14  2006/09/24 15:24:06  kados
-# remove Zebraauth routine, fold the functionality into Zconn
-# Zconn can now take several arguments ... this will probably
-# change soon as I'm not completely happy with the readability
-# of the current format ... see the POD for details.
-#
-# cleaning up Biblio.pm, removing unnecessary routines.
-#
-# DeleteBiblio - used to delete a biblio from zebra and koha tables
-#     -- checks to make sure there are no existing issues
-#     -- saves backups of biblio,biblioitems,items in deleted* tables
-#     -- does commit operation
-#
-# getRecord - used to retrieve one record from zebra in piggyback mode using biblionumber
-# brought back z3950_extended_services routine
-#
-# Lots of modifications to Context.pm, you can now store user and pass info for
-# multiple servers (for federated searching) using the <serverinfo> element.
-# I'll commit my koha.xml to demonstrate this or you can refer to the POD in
-# Context.pm (which I also expanded on).
-#
-# Revision 1.18.2.5.2.13  2006/08/10 02:10:21  kados
-# Turned warnings on, and running a search turned up lots of warnings.
-# Cleaned up those ...
-#
-# removed getitemtypes from Koha.pm (one in Search.pm looks newer)
-# removed itemcount from Biblio.pm
-#
-# made some local subs local with a _ prefix (as they were redefined
-# elsewhere)
-#
-# Add two new search subs to Search.pm the start of a new search API
-# that's a bit more scalable
-#
-# Revision 1.18.2.5.2.10  2006/07/21 17:50:51  kados
-# moving the *.properties files to intranetdir/etc dir
-#
-# Revision 1.18.2.5.2.9  2006/07/17 08:05:20  tipaul
-# there was a hardcoded link to /koha/etc/ I replaced it with intranetdir config value
-#
-# Revision 1.18.2.5.2.8  2006/07/11 12:20:37  kados
-# adding ccl and cql files ... Tumer, if you want to fit these into the
-# config file by all means do.
-#
-# Revision 1.18.2.5.2.7  2006/06/04 22:50:33  tgarip1957
-# We do not hard code cql2rpn conversion file in context.pm our koha.xml configuration file already describes the path for this file.
-# At cql searching we use method CQL not CQL2RPN as the cql2rpn conversion file is defined at server level
-#
-# Revision 1.18.2.5.2.6  2006/06/02 23:11:24  kados
-# Committing my working dev_week. It's been tested only with
-# searching, and there's quite a lot of config stuff to set up
-# beforehand. As things get closer to a release, we'll be making
-# some scripts to do it for us
-#
-# Revision 1.18.2.5.2.5  2006/05/28 18:49:12  tgarip1957
-# This is an unusual commit. The main purpose is a working model of Zebra on a modified rel2_2.
-# Any questions regarding these commits should be asked to Joshua Ferraro unless you are Joshua whom I'll report to
-#
-# Revision 1.36  2006/05/09 13:28:08  tipaul
-# adding the branchname and the librarian name in every page :
-# - modified userenv to add branchname
-# - modifier menus.inc to have the librarian name & userenv displayed on every page. they are in a librarian_information div.
-#
-# Revision 1.35  2006/04/13 08:40:11  plg
-# bug fixed: typo on Zconnauth name
-#
-# Revision 1.34  2006/04/10 21:40:23  tgarip1957
-# A new handler defined for zebra Zconnauth with read/write permission. Zconnauth should only be called in biblio.pm where write operations are. Use of this handler will break things unless koha.conf contains new variables:
-# zebradb=localhost
-# zebraport=<your port>
-# zebrauser=<username>
-# zebrapass=<password>
-#
-# The zebra.cfg file should read:
-# perm.anonymous:r
-# perm.username:rw
-# passw.c:<yourpasswordfile>
-#
-# Password file should be prepared with Apaches htpasswd utility in encrypted mode and should exist in a folder zebra.cfg can read
-#
-# Revision 1.33  2006/03/15 11:21:56  plg
-# bug fixed: utf-8 data where not displayed correctly in screens. Supposing
-# your data are truely utf-8 encoded in your database, they should be
-# correctly displayed. "set names 'UTF8'" on mysql connection (C4/Context.pm)
-# is mandatory and "binmode" to utf8 (C4/Interface/CGI/Output.pm) seemed to
-# converted data twice, so it was removed.
-#
-# Revision 1.32  2006/03/03 17:25:01  hdl
-# Bug fixing : a line missed a comment sign.
-#
-# Revision 1.31  2006/03/03 16:45:36  kados
-# Remove the search that tests the Zconn -- warning, still no fault
-# tollerance
-#
-# Revision 1.30  2006/02/22 00:56:59  kados
-# First go at a connection object for Zebra. You can now get a
-# connection object by doing:
-#
-# my $Zconn = C4::Context->Zconn;
-#
-# My initial tests indicate that as soon as your funcion ends
-# (ie, when you're done doing something) the connection will be
-# closed automatically. There may be some other way to make the
-# connection more stateful, I'm not sure...
-#
-# Local Variables:
-# tab-width: 4
-# End: