X-Git-Url: http://koha-dev.rot13.org:8081/gitweb/?a=blobdiff_plain;f=C4%2FContext.pm;h=0417c45075341cad9ef1091424e3a364f3202f1a;hb=28bb1a3ed01e89588b8f95d9ad4a53c700df862a;hp=484d4e10a8a061a0678157795314ef7008534601;hpb=b1317464eccc01edc7eaa055e2246b07d2b33d6d;p=koha_gimpoz diff --git a/C4/Context.pm b/C4/Context.pm index 484d4e10a8..0417c45075 100644 --- a/C4/Context.pm +++ b/C4/Context.pm @@ -18,7 +18,7 @@ package C4::Context; 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'}) { @@ -78,7 +78,24 @@ BEGIN { $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; @@ -229,20 +246,51 @@ Returns undef in case of error. sub read_config_file { # Pass argument naming config file to read 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 } @@ -274,6 +322,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. +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>. @@ -308,10 +360,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"}); @@ -462,7 +524,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}; @@ -513,7 +575,7 @@ the sysprefs cache. sub set_preference { my $self = shift; - my $var = shift; + my $var = lc(shift); my $value = shift; my $dbh = C4::Context->dbh or return 0; @@ -529,7 +591,9 @@ sub set_preference { ON DUPLICATE KEY UPDATE value = VALUES(value) " ); - $sth->execute( $var, $value ); + if($sth->execute( $var, $value )) { + $sysprefs{$var} = $value; + } $sth->finish; } @@ -690,7 +754,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. @@ -914,7 +978,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';