X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=C4%2FContext.pm;h=48bf9a6816eaad6f3de3e5d95cd69dff4a9316a6;hb=6a9b9b09b9b2cdf9e0a630068cd743f44f0254b5;hp=6451828ebfa391c37e90c270efb96b7741fa0262;hpb=e449c139fff95241bd3b9f1ddfc506d786a6e9a6;p=koha.git

diff --git a/C4/Context.pm b/C4/Context.pm
index 6451828ebf..48bf9a6816 100644
--- a/C4/Context.pm
+++ b/C4/Context.pm
@@ -16,19 +16,52 @@ package C4::Context;
 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
 # Suite 330, Boston, MA  02111-1307 USA
 
-# $Id$
 use strict;
+
+BEGIN {
+	if ($ENV{'HTTP_USER_AGENT'})	{
+		require CGI::Carp;
+		import CGI::Carp qw(fatalsToBrowser);
+			sub handle_errors {
+				my $msg = shift;
+				my $debug_level =  C4::Context->preference("DebugLevel");
+
+				if ($debug_level eq "2"){
+					# debug 2 , print extra info too.
+					my %versions = get_versions();
+
+		# a little example table with various version info";
+					print "
+						<h1>debug level $debug_level </h1>
+						<p>Got an error: $msg</p>
+						<table>
+						<tr><th>Apache<td>  $versions{apacheVersion}</tr>
+						<tr><th>Koha<td>    $versions{kohaVersion}</tr>
+						<tr><th>MySQL<td>   $versions{mysqlVersion}</tr>
+						<tr><th>OS<td>      $versions{osVersion}</tr>
+						<tr><th>Perl<td>    $versions{perlVersion}</tr>
+						</table>";
+
+				} elsif ($debug_level eq "1"){
+					print "<h1>debug level $debug_level </h1>";
+					print "<p>Got an error: $msg</p>";
+				} else {
+					print "production mode - trapped fatal";
+				}       
+			}       
+		CGI::Carp->set_message(\&handle_errors);
+    }  	# else there is no browser to send fatals to!
+}
+
 use DBI;
 use ZOOM;
 use XML::Simple;
 
 use C4::Boolean;
 
-use vars qw($VERSION $AUTOLOAD),
-    qw($context),
-    qw(@context_stack);
+use vars qw($VERSION $AUTOLOAD $context @context_stack);
 
-$VERSION = '3.00.00.002';
+$VERSION = '3.00.00.036';
 
 =head1 NAME
 
@@ -38,7 +71,7 @@ C4::Context - Maintain and manipulate the context of a Koha script
 
   use C4::Context;
 
-  use C4::Context("/path/to/koha.xml");
+  use C4::Context("/path/to/koha-conf.xml");
 
   $config_value = C4::Context->config("config_variable");
 
@@ -53,7 +86,7 @@ C4::Context - Maintain and manipulate the context of a Koha script
 =head1 DESCRIPTION
 
 When a Koha script runs, it makes use of a certain number of things:
-configuration settings in F</etc/koha.xml>, a connection to the Koha
+configuration settings in F</etc/koha/koha-conf.xml>, a connection to the Koha
 databases, and so forth. These things make up the I<context> in which
 the script runs.
 
@@ -74,7 +107,7 @@ different contexts to search both databases. Such scripts should use
 the C<&set_context> and C<&restore_context> functions, below.
 
 By default, C4::Context reads the configuration from
-F</etc/koha.xml>. This may be overridden by setting the C<$KOHA_CONF>
+F</etc/koha/koha-conf.xml>. This may be overridden by setting the C<$KOHA_CONF>
 environment variable to the pathname of a configuration file to use.
 
 =head1 METHODS
@@ -90,7 +123,7 @@ environment variable to the pathname of a configuration file to use.
 # config
 #    A reference-to-hash whose keys and values are the
 #    configuration variables and values specified in the config
-#    file (/etc/koha.xml).
+#    file (/etc/koha/koha-conf.xml).
 # dbh
 #    A handle to the appropriate database for this context.
 # dbh_stack
@@ -99,8 +132,30 @@ environment variable to the pathname of a configuration file to use.
 # Zconn
 #     A connection object for the Zebra server
 
-use constant CONFIG_FNAME => "/etc/koha.xml";
+# Koha's main configuration file koha-conf.xml
+# is searched for according to this priority list:
+#
+# 1. Path supplied via use C4::Context '/path/to/koha-conf.xml'
+# 2. Path supplied in KOHA_CONF environment variable.
+# 3. Path supplied in INSTALLED_CONFIG_FNAME, as long
+#    as value has changed from its default of 
+#    '__KOHA_CONF_DIR__/koha-conf.xml', as happens
+#    when Koha is installed in 'standard' or 'single'
+#    mode.
+# 4. Path supplied in CONFIG_FNAME.
+#
+# The first entry that refers to a readable file is used.
+
+use constant CONFIG_FNAME => "/etc/koha/koha-conf.xml";
                 # Default config file, if none is specified
+                
+my $INSTALLED_CONFIG_FNAME = '__KOHA_CONF_DIR__/koha-conf.xml';
+                # path to config file set by installer
+                # __KOHA_CONF_DIR__ is set by rewrite-confg.PL
+                # when Koha is installed in 'standard' or 'single'
+                # mode.  If Koha was installed in 'dev' mode, 
+                # __KOHA_CONF_DIR__ is *not* rewritten; instead
+                # developers should set the KOHA_CONF environment variable 
 
 $context = undef;        # Initially, no context is set
 @context_stack = ();        # Initially, no saved contexts
@@ -108,13 +163,21 @@ $context = undef;        # Initially, no context is set
 
 =item KOHAVERSION
     returns the kohaversion stored in kohaversion.pl file
+
 =cut
 
 sub KOHAVERSION {
     my $cgidir = C4::Context->intranetdir ."/cgi-bin";
+
+    # 2 cases here : on CVS install, $cgidir does not need a /cgi-bin
+    # on a standard install, /cgi-bin need to be added.
+    # test one, then the other
+    # FIXME - is this all really necessary?
     unless (opendir(DIR, "$cgidir/cataloguing/value_builder")) {
-            $cgidir = C4::Context->intranetdir;
+        $cgidir = C4::Context->intranetdir;
+        closedir(DIR);
     }
+
     do $cgidir."/kohaversion.pl" || die "NO $cgidir/kohaversion.pl";
     return kohaversion();
 }
@@ -126,7 +189,7 @@ Reads the specified Koha config file.
 
 Returns an object containing the configuration variables. The object's
 structure is a bit complex to the uninitiated ... take a look at the
-koha.xml file as well as the XML::Simple documentation for details. Or,
+koha-conf.xml file as well as the XML::Simple documentation for details. Or,
 here are a few examples that may give you what you need:
 
 The simple elements nested within the <config> element:
@@ -147,11 +210,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
@@ -184,11 +245,11 @@ sub import {
 =item new
 
   $context = new C4::Context;
-  $context = new C4::Context("/path/to/koha.xml");
+  $context = new C4::Context("/path/to/koha-conf.xml");
 
 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.xml>.
+environment variable, or F</etc/koha/koha-conf.xml>.
 
 C<&new> does not set this context as the new default context; for
 that, use C<&set_context>.
@@ -211,7 +272,18 @@ sub new {
     {
         # If the $KOHA_CONF environment variable is set, use
         # that. Otherwise, use the built-in default.
-        $conf_fname = $ENV{"KOHA_CONF"} || CONFIG_FNAME;
+        if (exists $ENV{"KOHA_CONF"} and $ENV{'KOHA_CONF'} and -e  $ENV{"KOHA_CONF"} and -s  $ENV{"KOHA_CONF"}) {
+            $conf_fname = $ENV{"KOHA_CONF"};
+        } elsif ($INSTALLED_CONFIG_FNAME !~ /__KOHA_CONF_DIR/ and -e $INSTALLED_CONFIG_FNAME and -s $INSTALLED_CONFIG_FNAME) {
+            # NOTE: be careful -- don't change __KOHA_CONF_DIR in the above
+            # regex to anything else -- don't want installer to rewrite it
+            $conf_fname = $INSTALLED_CONFIG_FNAME;
+        } elsif (-e CONFIG_FNAME and -s CONFIG_FNAME) {
+            $conf_fname = CONFIG_FNAME;
+        } else {
+            warn "unable to locate Koha configuration file koha-conf.xml";
+            return undef;
+        }
     }
         # Load the desired config file.
     $self = read_config_file($conf_fname);
@@ -320,50 +392,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");
@@ -383,10 +434,7 @@ sub preference
     my $self = shift;
     my $var = shift;        # The system preference to return
     my $retval;            # Return value
-    my $dbh = C4::Context->dbh;    # Database handle
-    if ($dbh){
-    my $sth;            # Database query handle
-
+    my $dbh = C4::Context->dbh or return 0;
     # Look up systempreferences.variable==$var
     $retval = $dbh->selectrow_array(<<EOT);
         SELECT    value
@@ -395,9 +443,6 @@ sub preference
         LIMIT    1
 EOT
     return $retval;
-    } else {
-      return 0
-    }
 }
 
 sub boolean_preference ($) {
@@ -435,7 +480,7 @@ creates one and connects.
 
 C<$self> 
 
-C<$server> one of the servers defined in the koha.xml file
+C<$server> one of the servers defined in the koha-conf.xml file
 
 C<$async> whether this is a asynchronous connection
 
@@ -453,7 +498,6 @@ sub Zconn {
     my $syntax=shift;
     if ( defined($context->{"Zconn"}->{$server}) ) {
         return $context->{"Zconn"}->{$server};
-
     # No connection object or it died. Create one.
     }else {
         $context->{"Zconn"}->{$server} = &_new_Zconn($server,$async,$auth,$piggyback,$syntax);
@@ -467,7 +511,7 @@ $context->{"Zconn"} = &_new_Zconn($server,$async);
 
 Internal function. Creates a new database connection from the data given in the current context and returns it.
 
-C<$server> one of the servers defined in the koha.xml file
+C<$server> one of the servers defined in the koha-conf.xml file
 
 C<$async> whether this is a asynchronous connection
 
@@ -484,21 +528,22 @@ sub _new_Zconn {
     $syntax = "usmarc" unless $syntax;
 
     my $host = $context->{'listen'}->{$server}->{'content'};
-    my $user = $context->{"serverinfo"}->{$server}->{"user"};
     my $servername = $context->{"config"}->{$server};
+    my $user = $context->{"serverinfo"}->{$server}->{"user"};
     my $password = $context->{"serverinfo"}->{$server}->{"password"};
+ $auth = 1 if($user && $password);   
     retry:
     eval {
         # set options
         my $o = new ZOOM::Options();
+        $o->option(user=>$user) if $auth;
+        $o->option(password=>$password) if $auth;
         $o->option(async => 1) if $async;
         $o->option(count => $piggyback) if $piggyback;
         $o->option(cqlfile=> $context->{"server"}->{$server}->{"cql2rpn"});
         $o->option(cclfile=> $context->{"serverinfo"}->{$server}->{"ccl2rpn"});
         $o->option(preferredRecordSyntax => $syntax);
         $o->option(elementSetName => "F"); # F for 'full' as opposed to B for 'brief'
-        $o->option(user=>$user) if $auth;
-        $o->option(password=>$password) if $auth;
         $o->option(databaseName => ($servername?$servername:"biblios"));
 
         # create a new connection object
@@ -539,6 +584,8 @@ sub _new_Zconn {
 # returns it.
 sub _new_dbh
 {
+
+### $context
     ##correct name for db_schme        
     my $db_driver;
     if ($context->config("db_scheme")){
@@ -549,14 +596,21 @@ 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:$db_name:$db_host",
-                $db_user, $db_passwd);
-    # Koha 3.0 is utf-8, so force utf8 communication between mySQL and koha, whatever the mysql default config.
-    # this is better than modifying my.cnf (and forcing all communications to be in utf8)
-    $dbh->do("set NAMES 'utf8'") if ($dbh);
-    $dbh->{'mysql_enable_utf8'}=1; #enable
+    my $dbh= DBI->connect("DBI:$db_driver:dbname=$db_name;host=$db_host;port=$db_port",
+         $db_user, $db_passwd);
+    if ( $db_driver eq 'mysql' ) { 
+        # Koha 3.0 is utf-8, so force utf8 communication between mySQL and koha, whatever the mysql default config.
+        # this is better than modifying my.cnf (and forcing all communications to be in utf8)
+        $dbh->{'mysql_enable_utf8'}=1; #enable
+        $dbh->do("set NAMES 'utf8'");
+    }
+    elsif ( $db_driver eq 'Pg' ) {
+	    $dbh->do( "set client_encoding = 'UTF8';" );
+    }
     return $dbh;
 }
 
@@ -776,7 +830,7 @@ sub userenv
     if ($context->{"dbh"} && $context->preference('insecure')) {
         my %insecure;
         $insecure{flags} = '16382';
-        $insecure{branchname} ='Insecure',
+        $insecure{branchname} ='Insecure';
         $insecure{number} ='0';
         $insecure{cardnumber} ='0';
         $insecure{id} = 'insecure';
@@ -803,7 +857,7 @@ set_userenv is called in Auth.pm
 
 #'
 sub set_userenv{
-    my ($usernum, $userid, $usercnum, $userfirstname, $usersurname, $userbranch, $branchname, $userflags, $emailaddress)= @_;
+    my ($usernum, $userid, $usercnum, $userfirstname, $usersurname, $userbranch, $branchname, $userflags, $emailaddress, $branchprinter)= @_;
     my $var=$context->{"activeuser"};
     my $cell = {
         "number"     => $usernum,
@@ -816,6 +870,7 @@ sub set_userenv{
         "branchname" => $branchname,
         "flags"      => $userflags,
         "emailaddress"    => $emailaddress,
+		"branchprinter"    => $branchprinter
     };
     $context->{userenv}->{$var} = $cell;
     return $cell;
@@ -859,6 +914,30 @@ sub _unset_userenv
 }
 
 
+=item get_versions
+
+  C4::Context->get_versions
+
+Gets various version info, for core Koha packages, Currently called from carp handle_errors() sub, to send to browser if 'DebugLevel' syspref is set to '2'.
+
+=cut
+
+#'
+
+# A little example sub to show more debugging info for CGI::Carp
+sub get_versions {
+    my %versions;
+    $versions{kohaVersion}  = C4::Context->config("kohaversion");
+    $versions{osVersion} = `uname -a`;
+    $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} ;
+    return %versions;
+}
+
 
 1;
 __END__
@@ -877,6 +956,8 @@ Specifies the configuration file to read.
 
 =head1 SEE ALSO
 
+XML::Simple
+
 =head1 AUTHORS
 
 Andrew Arensburger <arensb at ooblick dot com>
@@ -885,7 +966,6 @@ Joshua Ferraro <jmf at liblime dot com>
 
 =cut
 
-# $Log$
 # 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