# Suite 330, Boston, MA 02111-1307 USA
# $Id$
+# 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;
use DBI;
+use C4::Boolean;
use vars qw($VERSION $AUTOLOAD),
qw($context),
# whose keys are the configuration variables, and whose values are the
# configuration values (duh).
# Returns undef in case of error.
+#
+# Revision History:
+# 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 translation between the db_schema
+# and the DBI driver for that schema.
+#
sub read_config_file
{
my $fname = shift; # Config file to read
# var = value
if (!/^\s*(\w+)\s*=\s*(.*?)\s*$/)
{
- # FIXME - Complain about bogus line
+ print STDERR
+ "$_ isn't a variable assignment, skipping it";
next;
}
# Found a variable assignment
- # FIXME - Ought to complain is this line sets a
- # variable that was already set.
- $var = $1;
- $value = $2;
- $retval->{$var} = $value;
+ if ( exists $retval->{$1} )
+ {
+ print STDERR "$var was already defined, ignoring\n";
+ }else{
+ # Quick hack for allowing databases name in full text
+ if ( $1 eq "db_scheme" )
+ {
+ $value = db_scheme2dbi($2);
+ }else {
+ $value = $2;
+ }
+ $retval->{$1} = $value;
+ }
}
close CONF;
return $retval;
}
+# db_scheme2dbi
+# Translates the full text name of a database into de appropiate dbi name
+#
+sub db_scheme2dbi
+{
+ my $name = shift;
+
+ for ($name) {
+# FIXME - Should have other databases.
+ if (/mysql/i) { return("mysql"); }
+ if (/Postgres|Pg|PostgresSQL/) { return("Pg"); }
+ if (/oracle/i) { return("Oracle"); }
+ }
+ return undef; # Just in case
+}
+
sub import
{
my $package = shift;
=cut
#'
+# Revision History:
+# 2004-08-10 A. Tarallo: Added check if the conf file is not empty
sub new
{
my $class = shift;
my $conf_fname = shift; # Config file to load
my $self = {};
+ # check that the specified config file exists and is not empty
+ undef $conf_fname unless
+ (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;
# Load the desired config file.
$self->{"config"} = &read_config_file($conf_fname);
+ warn "read_config_file($conf_fname) returned undef" if !defined($self->{"config"});
return undef if !defined($self->{"config"});
$self->{"dbh"} = undef; # Database handle
$self->{"stopwords"} = undef; # stopwords list
+ $self->{"marcfromkohafield"} = undef; # the hash with relations between koha table fields and MARC field/subfield
bless $self, $class;
return $self;
return $retval;
}
+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;
+}
+
# AUTOLOAD
# This implements C4::Config->foo, and simply returns
# C4::Context->config("foo"), as described in the documentation for
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"};
my $db_passwd = $context->{"config"}{"pass"};
-
return DBI->connect("DBI:$db_driver:$db_name:$db_host",
$db_user, $db_passwd);
}
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));
+ }
- # No database handle yet. Create one.
+ # No database handle or it died . Create one.
$context->{"dbh"} = &_new_dbh();
return $context->{"dbh"};
# return something, then this function should, too.
}
+=item marcfromkohafield
+
+ $dbh = C4::Context->marcfromkohafield;
+
+Returns a hash with marcfromkohafield.
+
+This hash is cached for future use: if you call
+C<C4::Context-E<gt>marcfromkohafield> twice, you will get the same hash without real DB access
+
+=cut
+#'
+sub marcfromkohafield
+{
+ my $retval = {};
+
+ # If the hash already exists, return it.
+ return $context->{"marcfromkohafield"} if defined($context->{"marcfromkohafield"});
+
+ # No hash. Create one.
+ $context->{"marcfromkohafield"} = &_new_marcfromkohafield();
+
+ return $context->{"marcfromkohafield"};
+}
+
+# _new_marcfromkohafield
+# Internal helper function (not a method!). This creates a new
+# hash with stopwords
+sub _new_marcfromkohafield
+{
+ my $dbh = C4::Context->dbh;
+ my $marcfromkohafield;
+ my $sth = $dbh->prepare("select frameworkcode,kohafield,tagfield,tagsubfield from marc_subfield_structure where kohafield > ''");
+ $sth->execute;
+ while (my ($frameworkcode,$kohafield,$tagfield,$tagsubfield) = $sth->fetchrow) {
+ my $retval = {};
+ $marcfromkohafield->{$frameworkcode}->{$kohafield} = [$tagfield,$tagsubfield];
+ }
+ return $marcfromkohafield;
+}
+
=item stopwords
$dbh = C4::Context->stopwords;
return $stopwordlist;
}
+
+
1;
__END__