Able to call haspermission w/o $dbh, and add error msg on deletemember.

[koha.git] / C4 / Context.pm

diff --git a/C4/Context.pm b/C4/Context.pm
index 4be0395..63ad238 100644 (file)
--- a/C4/Context.pm
+++ b/C4/Context.pm
@@ -61,7 +61,7 @@ use C4::Boolean;
 
 use vars qw($VERSION $AUTOLOAD $context @context_stack);
 
-$VERSION = '3.00.00.005';
+$VERSION = '3.00.00.032';
 
 =head1 NAME
 
@@ -141,6 +141,7 @@ $context = undef;        # Initially, no context is set
 
 =item KOHAVERSION
     returns the kohaversion stored in kohaversion.pl file
+
 =cut
 
 sub KOHAVERSION {
@@ -187,11 +188,9 @@ Returns undef in case of error.
 
 =cut
 
-sub read_config_file {
-    my $fname = shift;    # Config file to read
-    my $retval = {};    # Return value: ref-to-hash holding the configuration
-    my $koha = XMLin($fname, keyattr => ['id'],forcearray => ['listen', 'server', 'serverinfo']);
-    return $koha;
+sub read_config_file {         # Pass argument naming config file to read
+    my $koha = XMLin(shift, keyattr => ['id'], forcearray => ['listen', 'server', 'serverinfo']);
+    return $koha;                      # Return value: ref-to-hash holding the configuration
 }
 
 # db_scheme2dbi
@@ -360,50 +359,29 @@ C<C4::Config-E<gt>new> will not return it.
 
 =cut
 
-#'
-sub config
-{
-    my $self = shift;
-    my $var = shift;        # The config variable to return
-
-    return undef if !defined($context->{"config"});
-            # Presumably $self->{config} might be
-            # undefined if the config file given to &new
-            # didn't exist, and the caller didn't bother
-            # to check the return value.
+sub _common_config ($$) {
+       my $var = shift;
+       my $term = shift;
+    return undef 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
+       # to check the return value.
 
     # Return the value of the requested config variable
-    return $context->{"config"}->{$var};
+    return $context->{$term}->{$var};
 }
 
-sub zebraconfig
-{
-    my $self = shift;
-    my $var = shift;        # The config variable to return
-
-    return undef if !defined($context->{"server"});
-            # Presumably $self->{config} might be
-            # undefined if the config file given to &new
-            # didn't exist, and the caller didn't bother
-            # to check the return value.
-
-    # Return the value of the requested config variable
-    return $context->{"server"}->{$var};
+sub config {
+       return _common_config($_[1],'config');
 }
-sub ModZebrations
-{
-    my $self = shift;
-    my $var = shift;        # The config variable to return
-
-    return undef if !defined($context->{"serverinfo"});
-            # Presumably $self->{config} might be
-            # undefined if the config file given to &new
-            # didn't exist, and the caller didn't bother
-            # to check the return value.
-
-    # Return the value of the requested config variable
-    return $context->{"serverinfo"}->{$var};
+sub zebraconfig {
+       return _common_config($_[1],'server');
 }
+sub ModZebrations {
+       return _common_config($_[1],'serverinfo');
+}
+
 =item preference
 
   $sys_preference = C4::Context->preference("some_variable");
@@ -586,6 +564,7 @@ sub _new_dbh
     my $db_name   = $context->config("database");
     my $db_host   = $context->config("hostname");
     my $db_port   = $context->config("port");
+    $db_port = "" unless defined $db_port;
     my $db_user   = $context->config("user");
     my $db_passwd = $context->config("pass");
     my $dbh= DBI->connect("DBI:$db_driver:dbname=$db_name;host=$db_host;port=$db_port",
@@ -596,6 +575,9 @@ sub _new_dbh
         $dbh->do("set NAMES 'utf8'") if ($dbh);
         $dbh->{'mysql_enable_utf8'}=1; #enable
     }
+    elsif ( $db_driver eq 'Pg' ) {
+           $dbh->do( "set client_encoding = 'UTF8';" );
+    }
     return $dbh;
 }
 
@@ -941,6 +923,8 @@ Specifies the configuration file to read.
 
 =head1 SEE ALSO
 
+XML::Simple
+
 =head1 AUTHORS
 
 Andrew Arensburger <arensb at ooblick dot com>