# 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;
# 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
- undef $conf_fname unless (defined $conf_fname && -e $conf_fname);
+ # 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
+ $self->{"userenv"} = undef; # User env
+ $self->{"activeuser"} = undef; # current active user
bless $self, $class;
return $self;
sub boolean_preference ($) {
my $self = shift;
my $var = shift; # The system preference to return
- my $it = preference($var);
- return defined($it)? C4::Boolean::is_true($it): undef;
+ my $it = preference($self, $var);
+ return defined($it)? C4::Boolean::true_p($it): undef;
}
# 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"};
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;
}
+=item userenv
+
+ %userenv = C4::Context->userenv;
+
+Returns a hash with userenvironment variables.
+
+This hash is cached for future use: if you call
+C<C4::Context-E<gt>userenv> twice, you will get the same hash without real DB access
+
+Returns Null if userenv is not set.
+userenv is set in _new_userenv, called in Auth.pm
+
+=cut
+#'
+
+=item userenv
+
+ C4::Context->userenv;
+
+Builds a hash for user environment variables.
+
+This hash shall be cached for future use: if you call
+C<C4::Context-E<gt>userenv> twice, you will get the same hash without real DB access
+
+set_userenv is called in Auth.pm
+
+=cut
+#'
+sub userenv
+{
+ my $var = $context->{"activeuser"};
+ return $context->{"userenv"}->{$var} if (defined $context->{"userenv"}->{$var});
+}
+
+=item userenv
+
+ C4::Context->set_userenv;
+
+Builds a hash for user environment variables.
+
+This hash shall be cached for future use: if you call
+C<C4::Context-E<gt>userenv> twice, you will get the same hash without real DB access
+
+set_userenv is called in Auth.pm
+
+=cut
+#'
+sub set_userenv{
+ my ($usernum, $userid, $usercnum, $userfirstname, $usersurname, $userbranch, $userflags)= @_;
+ my $var=$context->{"activeuser"};
+ my $cell = {
+ "number" => $usernum,
+ "id" => $userid,
+ "cardnumber" => $usercnum,
+ "firstname" => $userfirstname,
+ "surname" => $usersurname,
+ "branch" => $userbranch,
+ "flags" => $userflags
+ };
+ $context->{userenv}->{$var} = $cell;
+ return $cell;
+}
+
+=item _new_userenv
+
+ C4::Context->_new_userenv($session);
+
+Builds a hash for user environment variables.
+
+This hash shall be cached for future use: if you call
+C<C4::Context-E<gt>userenv> twice, you will get the same hash without real DB access
+
+_new_userenv is called in Auth.pm
+
+=cut
+#'
+sub _new_userenv
+{
+ shift;
+ my ($sessionID)= @_;
+ $context->{"activeuser"}=$sessionID;
+}
+
+=item _unset_userenv
+
+ C4::Context->_unset_userenv;
+
+Destroys the hash for activeuser user environment variables.
+
+=cut
+#'
+
+sub _unset_userenv
+{
+ my ($sessionID)= @_;
+# undef $context->{$sessionID};
+ undef $context->{"activeuser"} if ($context->{"activeuser"} eq $sessionID);
+# $context->{"activeuser"}--;
+}
+
+
1;
__END__
projects / koha.git / blobdiff