Bug 7684: (follow-up) fix UTF-8 encoding problems in CSV export
[koha.git] / C4 / Context.pm
index 9ce6c74..39927d4 100644 (file)
@@ -19,7 +19,6 @@ package C4::Context;
 use strict;
 use warnings;
 use vars qw($VERSION $AUTOLOAD $context @context_stack $servers $memcached $ismemcached);
-
 BEGIN {
        if ($ENV{'HTTP_USER_AGENT'})    {
                require CGI::Carp;
@@ -105,6 +104,7 @@ use C4::Boolean;
 use C4::Debug;
 use POSIX ();
 use DateTime::TimeZone;
+use Module::Load::Conditional qw(can_load);
 
 =head1 NAME
 
@@ -220,6 +220,18 @@ sub KOHAVERSION {
     do $cgidir."/kohaversion.pl" || die "NO $cgidir/kohaversion.pl";
     return kohaversion();
 }
+
+=head2 final_linear_version
+
+Returns the version number of the final update to run in updatedatabase.pl.
+This number is equal to the version in kohaversion.pl
+
+=cut
+
+sub final_linear_version {
+    return KOHAVERSION;
+}
+
 =head2 read_config_file
 
 Reads the specified Koha config file. 
@@ -276,7 +288,7 @@ sub memcached {
     if ($ismemcached) {
       return $memcached;
     } else {
-      return undef;
+      return;
     }
 }
 
@@ -293,7 +305,7 @@ sub db_scheme2dbi {
         if (/Postgres|Pg|PostgresSQL/) { return("Pg"); }
         if (/oracle/) { return("Oracle"); }
     }
-    return undef;         # Just in case
+    return;         # Just in case
 }
 
 sub import {
@@ -358,7 +370,7 @@ sub new {
             $conf_fname = CONFIG_FNAME;
         } else {
             warn "unable to locate Koha configuration file koha-conf.xml";
-            return undef;
+            return;
         }
     }
     
@@ -376,7 +388,7 @@ sub new {
 
     $self->{"config_file"} = $conf_fname;
     warn "read_config_file($conf_fname) returned undef" if !defined($self->{"config"});
-    return undef if !defined($self->{"config"});
+    return if !defined($self->{"config"});
 
     $self->{"dbh"} = undef;        # Database handle
     $self->{"Zconn"} = undef;    # Zebra Connections
@@ -480,10 +492,10 @@ C<C4::Config-E<gt>new> will not return it.
 
 =cut
 
-sub _common_config ($$) {
+sub _common_config {
        my $var = shift;
        my $term = shift;
-    return undef if !defined($context->{$term});
+    return if !defined($context->{$term});
        # Presumably $self->{$term} might be
        # undefined if the config file given to &new
        # didn't exist, and the caller didn't bother
@@ -523,35 +535,72 @@ with this method.
 # flushing the caching mechanism.
 
 my %sysprefs;
+my $use_syspref_cache = 1;
 
 sub preference {
     my $self = shift;
-    my $var  = lc(shift);                          # The system preference to return
+    my $var  = shift;    # The system preference to return
 
-    if (exists $sysprefs{$var}) {
-        return $sysprefs{$var};
+    if ($use_syspref_cache && exists $sysprefs{lc $var}) {
+        return $sysprefs{lc $var};
     }
 
     my $dbh  = C4::Context->dbh or return 0;
 
-    # Look up systempreferences.variable==$var
-    my $sql = <<'END_SQL';
-        SELECT    value
-        FROM    systempreferences
-        WHERE    variable=?
-        LIMIT    1
-END_SQL
-    $sysprefs{$var} = $dbh->selectrow_array( $sql, {}, $var );
-    return $sysprefs{$var};
+    my $value;
+    if ( defined $ENV{"OVERRIDE_SYSPREF_$var"} ) {
+        $value = $ENV{"OVERRIDE_SYSPREF_$var"};
+    } else {
+        # Look up systempreferences.variable==$var
+        my $sql = q{
+            SELECT  value
+            FROM    systempreferences
+            WHERE   variable = ?
+            LIMIT   1
+        };
+        $value = $dbh->selectrow_array( $sql, {}, lc $var );
+    }
+
+    $sysprefs{lc $var} = $value;
+    return $value;
 }
 
-sub boolean_preference ($) {
+sub boolean_preference {
     my $self = shift;
     my $var = shift;        # The system preference to return
     my $it = preference($self, $var);
     return defined($it)? C4::Boolean::true_p($it): undef;
 }
 
+=head2 enable_syspref_cache
+
+  C4::Context->enable_syspref_cache();
+
+Enable the in-memory syspref cache used by C4::Context. This is the
+default behavior.
+
+=cut
+
+sub enable_syspref_cache {
+    my ($self) = @_;
+    $use_syspref_cache = 1;
+}
+
+=head2 disable_syspref_cache
+
+  C4::Context->disable_syspref_cache();
+
+Disable the in-memory syspref cache used by C4::Context. This should be
+used with Plack and other persistent environments.
+
+=cut
+
+sub disable_syspref_cache {
+    my ($self) = @_;
+    $use_syspref_cache = 0;
+    $self->clear_syspref_cache();
+}
+
 =head2 clear_syspref_cache
 
   C4::Context->clear_syspref_cache();
@@ -656,6 +705,8 @@ sub Zconn {
         $context->{"Zconn"}->{$server}->destroy() if defined($context->{"Zconn"}->{$server});
 
         $context->{"Zconn"}->{$server} = &_new_Zconn($server,$async,$auth,$piggyback,$syntax);
+        $context->{ Zconn }->{ $server }->option(
+            preferredRecordSyntax => C4::Context->preference("marcflavour") );
         return $context->{"Zconn"}->{$server};
     }
 }
@@ -755,8 +806,23 @@ sub _new_dbh
     my $db_user   = $context->config("user");
     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",
+    my $dbh = DBI->connect("DBI:$db_driver:dbname=$db_name;host=$db_host;port=$db_port",
     $db_user, $db_passwd, {'RaiseError' => $ENV{DEBUG}?1:0 }) or die $DBI::errstr;
+
+    # Check for the existence of a systempreference table; if we don't have this, we don't
+    # have a valid database and should not set RaiseError in order to allow the installer
+    # to run; installer will not run otherwise since we raise all db errors
+
+    eval {
+                local $dbh->{PrintError} = 0;
+                local $dbh->{RaiseError} = 1;
+                $dbh->do(qq{SELECT * FROM systempreferences WHERE 1 = 0 });
+    };
+
+    if ($@) {
+        $dbh->{RaiseError} = 0;
+    }
+
        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.
@@ -882,6 +948,51 @@ sub restore_dbh
     # return something, then this function should, too.
 }
 
+=head2 queryparser
+
+  $queryparser = C4::Context->queryparser
+
+Returns a handle to an initialized Koha::QueryParser::Driver::PQF object.
+
+=cut
+
+sub queryparser {
+    my $self = shift;
+    unless (defined $context->{"queryparser"}) {
+        $context->{"queryparser"} = &_new_queryparser();
+    }
+
+    return
+      defined( $context->{"queryparser"} )
+      ? $context->{"queryparser"}->new
+      : undef;
+}
+
+=head2 _new_queryparser
+
+Internal helper function to create a new QueryParser object. QueryParser
+is loaded dynamically so as to keep the lack of the QueryParser library from
+getting in anyone's way.
+
+=cut
+
+sub _new_queryparser {
+    my $qpmodules = {
+        'OpenILS::QueryParser'           => undef,
+        'Koha::QueryParser::Driver::PQF' => undef
+    };
+    if ( can_load( 'modules' => $qpmodules ) ) {
+        my $QParser     = Koha::QueryParser::Driver::PQF->new();
+        my $config_file = $context->config('queryparser_config');
+        $config_file ||= '/etc/koha/searchengine/queryparser.yaml';
+        if ( $QParser->load_config($config_file) ) {
+            # TODO: allow indexes to be configured in the database
+            return $QParser;
+        }
+    }
+    return;
+}
+
 =head2 marcfromkohafield
 
   $dbh = C4::Context->marcfromkohafield;
@@ -978,18 +1089,8 @@ C<C4::Context-E<gt>userenv> twice, you will get the same hash without real DB ac
 #'
 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') eq 'yes') {
-        my %insecure;
-        $insecure{flags} = '16382';
-        $insecure{branchname} ='Insecure';
-        $insecure{number} ='0';
-        $insecure{cardnumber} ='0';
-        $insecure{id} = 'insecure';
-        $insecure{branch} = 'INS';
-        $insecure{emailaddress} = 'test@mode.insecure.com';
-        return \%insecure;
+    if (defined $var and defined $context->{"userenv"}->{$var}) {
+        return $context->{"userenv"}->{$var};
     } else {
         return;
     }
@@ -998,7 +1099,8 @@ sub userenv {
 =head2 set_userenv
 
   C4::Context->set_userenv($usernum, $userid, $usercnum, $userfirstname, 
-                  $usersurname, $userbranch, $userflags, $emailaddress);
+                  $usersurname, $userbranch, $userflags, $emailaddress, $branchprinter,
+                  $persona);
 
 Establish a hash of user environment variables.
 
@@ -1008,8 +1110,8 @@ set_userenv is called in Auth.pm
 
 #'
 sub set_userenv {
-    my ($usernum, $userid, $usercnum, $userfirstname, $usersurname, $userbranch, $branchname, $userflags, $emailaddress, $branchprinter)= @_;
-    my $var=$context->{"activeuser"};
+    my ($usernum, $userid, $usercnum, $userfirstname, $usersurname, $userbranch, $branchname, $userflags, $emailaddress, $branchprinter, $persona)= @_;
+    my $var=$context->{"activeuser"} || '';
     my $cell = {
         "number"     => $usernum,
         "id"         => $userid,
@@ -1021,25 +1123,26 @@ sub set_userenv {
         "branchname" => $branchname,
         "flags"      => $userflags,
         "emailaddress"     => $emailaddress,
-        "branchprinter"    => $branchprinter
+        "branchprinter"    => $branchprinter,
+        "persona"    => $persona,
     };
     $context->{userenv}->{$var} = $cell;
     return $cell;
 }
 
-sub set_shelves_userenv ($$) {
-       my ($type, $shelves) = @_ or return undef;
-       my $activeuser = $context->{activeuser} or return undef;
+sub set_shelves_userenv {
+       my ($type, $shelves) = @_ or return;
+       my $activeuser = $context->{activeuser} or return;
        $context->{userenv}->{$activeuser}->{barshelves} = $shelves if $type eq 'bar';
        $context->{userenv}->{$activeuser}->{pubshelves} = $shelves if $type eq 'pub';
        $context->{userenv}->{$activeuser}->{totshelves} = $shelves if $type eq 'tot';
 }
 
-sub get_shelves_userenv () {
+sub get_shelves_userenv {
        my $active;
        unless ($active = $context->{userenv}->{$context->{activeuser}}) {
                $debug and warn "get_shelves_userenv cannot retrieve context->{userenv}->{context->{activeuser}}";
-               return undef;
+               return;
        }
        my $totshelves = $active->{totshelves} or undef;
        my $pubshelves = $active->{pubshelves} or undef;