From 56ab39361e3e4a3cd6ed042a58c27da6435a7e25 Mon Sep 17 00:00:00 2001
From: tipaul <tipaul>
Date: Fri, 3 Dec 2004 16:50:39 +0000
Subject: [PATCH] fixes from A. Tarallo, for mod_perl compliance

---
 C4/Context.pm                     | 35 +++++++++++++++++--------------
 admin/marc_subfields_structure.pl |  4 +++-
 2 files changed, 22 insertions(+), 17 deletions(-)

diff --git a/C4/Context.pm b/C4/Context.pm
index 7de55593ba..4b882459f0 100644
--- a/C4/Context.pm
+++ b/C4/Context.pm
@@ -19,6 +19,8 @@
 # Revision History:
 # 2004-08-11 A. Tarallo: Added the function db_escheme2dbi, tested my bugfixes,
 # further  details about them in the code.
+# 2004-11-23 A. Tarallo, E. Silva: Bugfixes for running in a mod_perl environment.
+# Clean up of previous bugfixes, better documentation of what was done. 
 
 package C4::Context;
 use strict;
@@ -105,13 +107,13 @@ $context = undef;		# Initially, no context is set
 # Returns undef in case of error.
 #
 # Revision History:
-# 2004-08-10 A. Tarallo: Added code that checks if a variable was already
+# 2004-08-10 A. Tarallo: Added code that checks if a variable is already
 # assigned and prints a message, otherwise create a new entry in the hash to
 # be returned. 
 # Also added code that complaints if finds a line that isn't a variable 
 # assignmet and skips the line.
-# Added a quick hack that makes the trasnlation between the db_schema
-# and the DBI driver for that eschema.
+# Added a quick hack that makes the translation between the db_schema
+# and the DBI driver for that schema.
 #
 sub read_config_file
 {
@@ -151,8 +153,7 @@ sub read_config_file
 			}else {
 				$value = $2;
 			}
-			$var = $1;
-                        $retval->{$var} = $value;
+                        $retval->{$1} = $value;
 		}
 	}
 	close CONF;
@@ -168,9 +169,10 @@ sub db_scheme2dbi
 	my $name = shift;
 
 	for ($name) {
-		if (/MySQL|mysql/) { return("mysql"); }
+# FIXME - Should have other databases. 
+		if (/mysql/i) { return("mysql"); }
 		if (/Postgres|Pg|PostgresSQL/) { return("Pg"); }
-		if (/Oracle|oracle|ORACLE/) { return("Oracle"); }
+		if (/oracle/i) { return("Oracle"); }
 	}
 	return undef; 		# Just in case
 }
@@ -212,14 +214,13 @@ sub new
 
 	# check that the specified config file exists and is not empty
 	undef $conf_fname unless 
-		(defined $conf_fname && -e $conf_fname && -s $conf_fname);
+	    (defined $conf_fname && -e $conf_fname && -s $conf_fname);
 	# Figure out a good config file to load if none was specified.
 	if (!defined($conf_fname))
 	{
 		# If the $KOHA_CONF environment variable is set, use
 		# that. Otherwise, use the built-in default.
-		$conf_fname = $ENV{"KOHA_CONF"} ||
-				CONFIG_FNAME;
+		$conf_fname = $ENV{"KOHA_CONF"} || CONFIG_FNAME;
 	}
 	$self->{"config_file"} = $conf_fname;
 
@@ -399,9 +400,6 @@ sub AUTOLOAD
 sub _new_dbh
 {
 	my $db_driver = $context->{"config"}{"db_scheme"} || "mysql";
-		# FIXME - It should be possible to use "MySQL" instead
-		# of "mysql", "PostgreSQL" instead of "Pg", and so
-		# forth.
 	my $db_name   = $context->{"config"}{"database"};
 	my $db_host   = $context->{"config"}{"hostname"};
 	my $db_user   = $context->{"config"}{"user"};
@@ -428,11 +426,16 @@ possibly C<&set_dbh>.
 sub dbh
 {
 	my $self = shift;
+	my $sth;
 
-	# If there's already a database handle, return it.
-	return $context->{"dbh"} if defined($context->{"dbh"});
+	if (defined($context->{"dbh"})) {
+	    $sth=$context->{"dbh"}->prepare("select 1");
+	    return $context->{"dbh"} if (defined($sth->execute));
+	}
+
+	warn "Database died";
 
-	# No database handle yet. Create one.
+	# No database handle or it died . Create one.
 	$context->{"dbh"} = &_new_dbh();
 
 	return $context->{"dbh"};
diff --git a/admin/marc_subfields_structure.pl b/admin/marc_subfields_structure.pl
index c758b0188a..1c5d9e9bd6 100755
--- a/admin/marc_subfields_structure.pl
+++ b/admin/marc_subfields_structure.pl
@@ -132,7 +132,9 @@ if ($op eq 'add_form') {
 	}
 	# build value_builder list
 	my @value_builder=('');
-	opendir(DIR, "../value_builder") || die "can't opendir ../value_builder: $!";
+
+	my $cgidir = C4::Context->intranetdir . "/cgi-bin";
+	opendir(DIR, "$cgidir/value_builder") || die "can't opendir $cgidir/value_builder: $!";
 	while (my $line = readdir(DIR)) {
 		if ($line =~ /\.pl$/) {
 			push (@value_builder,$line);
-- 
2.39.5