# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# 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),
$config_value = C4::Context->config("config_variable");
$db_handle = C4::Context->dbh;
+ $stopwordhash = C4::Context->stopwords;
=head1 DESCRIPTION
# 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
- my $retval; # Return value: ref-to-hash holding the
+ my $retval = {}; # Return value: ref-to-hash holding the
# configuration
open (CONF, $fname) or return undef;
# 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;
# Create a new context from the given config file name, if
# any, then set it as the current context.
- $context = __PACKAGE__->new($conf_fname);
+ $context = new C4::Context($conf_fname);
+ return undef if !defined($context);
$context->set_context;
}
=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);
- return null if !defined($self->{"config"});
+ 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;
=item config
- $value = C4::Config->config("config_variable");
+ $value = C4::Context->config("config_variable");
- $value = C4::Config->config_variable;
+ $value = C4::Context->config_variable;
Returns the value of a variable specified in the configuration file
from which the current context was created.
return $context->{"config"}{$var};
}
+=item preference
+
+ $sys_preference = C4::Context->preference("some_variable");
+
+Looks up the value of the given system preference in the
+systempreferences table of the Koha database, and returns it. If the
+variable is not set, or in case of error, returns the undefined value.
+
+=cut
+#'
+# FIXME - The preferences aren't likely to change over the lifetime of
+# the script (and things might break if they did change), so perhaps
+# this function should cache the results it finds.
+sub preference
+{
+ my $self = shift;
+ my $var = shift; # The system preference to return
+ my $retval; # Return value
+ my $dbh = C4::Context->dbh; # Database handle
+ my $sth; # Database query handle
+
+ # Look up systempreferences.variable==$var
+ $retval = $dbh->selectrow_array(<<EOT);
+ SELECT value
+ FROM systempreferences
+ WHERE variable='$var'
+ LIMIT 1
+EOT
+ 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::Config->config("foo"), as described in the documentation for
+# C4::Context->config("foo"), as described in the documentation for
# &config, above.
+
+# FIXME - Perhaps this should be extended to check &config first, and
+# then &preference if that fails. OTOH, AUTOLOAD could lead to crappy
+# code, so it'd probably be best to delete it altogether so as not to
+# encourage people to use it.
sub AUTOLOAD
{
my $self = shift;
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;
+
+Returns a hash with stopwords.
+
+This hash is cached for future use: if you call
+C<C4::Context-E<gt>stopwords> twice, you will get the same hash without real DB access
+
+=cut
+#'
+sub stopwords
+{
+ my $retval = {};
+
+ # If the hash already exists, return it.
+ return $context->{"stopwords"} if defined($context->{"stopwords"});
+
+ # No hash. Create one.
+ $context->{"stopwords"} = &_new_stopwords();
+
+ return $context->{"stopwords"};
+}
+
+# _new_stopwords
+# Internal helper function (not a method!). This creates a new
+# hash with stopwords
+sub _new_stopwords
+{
+ my $dbh = C4::Context->dbh;
+ my $stopwordlist;
+ my $sth = $dbh->prepare("select word from stopwords");
+ $sth->execute;
+ while (my $stopword = $sth->fetchrow_array) {
+ my $retval = {};
+ $stopwordlist->{$stopword} = uc($stopword);
+ }
+ return $stopwordlist;
+}
+
+
+
1;
__END__
+
=back
=head1 ENVIRONMENT
=head1 SEE ALSO
-L<DBI(3)|DBI>
+DBI(3)
=head1 AUTHOR
-Andrew Arensburger
+Andrew Arensburger <arensb at ooblick dot com>
=cut