# 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.
-
package C4::Context;
use strict;
use DBI;
use C4::Boolean;
-
+use XML::Simple;
use vars qw($VERSION $AUTOLOAD),
qw($context),
qw(@context_stack);
use C4::Context;
- use C4::Context("/path/to/koha.conf");
+ use C4::Context("/path/to/koha.xml");
$config_value = C4::Context->config("config_variable");
$db_handle = C4::Context->dbh;
=head1 DESCRIPTION
When a Koha script runs, it makes use of a certain number of things:
-configuration settings in F</etc/koha.conf>, a connection to the Koha
-database, and so forth. These things make up the I<context> in which
+configuration settings in F</etc/koha.xml>, a connection to the Koha
+databases, and so forth. These things make up the I<context> in which
the script runs.
This module takes care of setting up the context for a script:
the C<&set_context> and C<&restore_context> functions, below.
By default, C4::Context reads the configuration from
-F</etc/koha.conf>. This may be overridden by setting the C<$KOHA_CONF>
+F</etc/koha.xml>. This may be overridden by setting the C<$KOHA_CONF>
environment variable to the pathname of a configuration file to use.
=head1 METHODS
=over 2
=cut
+
#'
# In addition to what is said in the POD above, a Context object is a
# reference-to-hash with the following fields:
# config
# A reference-to-hash whose keys and values are the
# configuration variables and values specified in the config
-# file (/etc/koha.conf).
+# file (/etc/koha.xml).
# dbh
# A handle to the appropriate database for this context.
# dbh_stack
# Used by &set_dbh and &restore_dbh to hold other database
# handles for this context.
+# Zconn
+# A connection object for the Zebra server
-use constant CONFIG_FNAME => "/etc/koha.conf";
+use constant CONFIG_FNAME => "/etc/koha.xml";
# Default config file, if none is specified
$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
{
my $fname = shift; # Config file to read
+
my $retval = {}; # Return value: ref-to-hash holding the
# configuration
- open (CONF, $fname) or return undef;
+my $koha = XMLin($fname, keyattr => ['id'],forcearray => ['listen']);
- while (<CONF>)
- {
- my $var; # Variable name
- my $value; # Variable value
-
- chomp;
- s/#.*//; # Strip comments
- next if /^\s*$/; # Ignore blank lines
-
- # Look for a line of the form
- # var = value
- if (!/^\s*(\w+)\s*=\s*(.*?)\s*$/)
- {
- print STDERR
- "$_ isn't a variable assignment, skipping it";
- next;
- }
-
- # Found a variable assignment
- 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;
- }
- $var = $1;
- $retval->{$var} = $value;
- }
- }
- close CONF;
-
- return $retval;
+ return $koha;
}
# 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
}
=item new
$context = new C4::Context;
- $context = new C4::Context("/path/to/koha.conf");
+ $context = new C4::Context("/path/to/koha.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.conf>.
+environment variable, or F</etc/koha.xml>.
C<&new> does not set this context as the new default context; for
that, use C<&set_context>.
=cut
+
#'
# Revision History:
# 2004-08-10 A. Tarallo: Added check if the conf file is not empty
# 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;
}
+ # Load the desired config file.
+ $self = read_config_file($conf_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->{"Zconn"} = undef; # Zebra Connection
+ $self->{"Zconnauth"} = undef; # Zebra Connection for updating
$self->{"stopwords"} = undef; # stopwords list
+ $self->{"marcfromkohafield"} = undef; # the hash with relations between koha table fields and MARC field/subfield
+ $self->{"attrfromkohafield"} = undef; # the hash with relations between koha table fields and Bib1-attributes
+ $self->{"userenv"} = undef; # User env
+ $self->{"activeuser"} = undef; # current active user
bless $self, $class;
return $self;
operations. To restore the previous context, use C<&restore_context>.
=cut
+
#'
sub set_context
{
Restores the context set by C<&set_context>.
=cut
+
#'
sub restore_context
{
C<C4::Config-E<gt>new> will not return it.
=cut
+
#'
sub config
{
# to check the return value.
# Return the value of the requested config variable
- return $context->{"config"}{$var};
+ return $context->{"config"}->{$var};
}
+=item zebraconfig
+$serverdir=C4::Context->zebraconfig("biblioserver")->{directory};
+
+returns the zebra server specific details for different zebra servers
+similar to C4:Context->config
+=cut
+
+sub zebraconfig
+{
+ my $self = shift;
+ my $var = shift; # The config variable to return
+ return undef if !defined($context->{"server"});
+ # Return the value of the requested config variable
+ return $context->{"server"}->{$var};
+}
=item preference
$sys_preference = C4::Context->preference("some_variable");
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
return $self->config($AUTOLOAD);
}
+=item Zconn
+
+$Zconn = C4::Context->Zconn
+$Zconnauth = C4::Context->Zconnauth
+Returns a connection to the Zebra database for the current
+context. If no connection has yet been made, this method
+creates one and connects.
+
+=cut
+
+sub Zconn {
+ my $self = shift;
+my $server=shift;
+my $syntax=shift;
+ my $Zconn;
+ $context->{"Zconn"} = &new_Zconn($server,$syntax);
+ return $context->{"Zconn"};
+
+}
+
+sub Zconnauth {
+ my $self = shift;
+my $server=shift;
+my $syntax=shift;
+ my $Zconnauth;
+##We destroy each connection made so create a new one
+ $context->{"Zconnauth"} = &new_Zconnauth($server,$syntax);
+ return $context->{"Zconnauth"};
+
+}
+
+
+
+=item new_Zconn
+
+Internal helper function. creates a new database connection from
+the data given in the current context and returns it.
+
+=cut
+
+sub new_Zconn {
+use ZOOM;
+my $server=shift;
+my $syntax=shift;
+$syntax="xml" unless $syntax;
+my $Zconn;
+my ($tcp,$host,$port)=split /:/,$context->{"listen"}->{$server}->{"content"};
+my $o = new ZOOM::Options();
+$o->option(async => 1);
+$o->option(preferredRecordSyntax => $syntax); ## in case we use MARC
+$o->option(databaseName=>$context->{"config"}->{$server});
+
+my $o2= new ZOOM::Options();
+
+ $Zconn=create ZOOM::Connection($o);
+ $Zconn->connect($context->{"config"}->{"hostname"},$port);
+
+ return $Zconn;
+}
+
+## Zebra handler with write permission
+sub new_Zconnauth {
+use ZOOM;
+my $server=shift;
+my $syntax=shift;
+$syntax="xml" unless $syntax;
+my $Zconnauth;
+my ($tcp,$host,$port)=split /:/,$context->{"listen"}->{$server}->{"content"};
+my $o = new ZOOM::Options();
+#$o->option(async => 1);
+$o->option(preferredRecordSyntax => $syntax);
+$o->option(user=>$context->{"config"}->{"zebrauser"});
+$o->option(password=>$context->{"config"}->{"zebrapass"});
+$o->option(databaseName=>$context->{"config"}->{$server});
+ $o->option(charset=>"UTF8");
+ $Zconnauth=create ZOOM::Connection($o);
+$Zconnauth->connect($context->config("hostname"),$port);
+return $Zconnauth;
+}
+
+
# _new_dbh
# Internal helper function (not a method!). This creates a new
# database connection from the data given in the current context, and
# returns it.
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",
+ ##correct name for db_schme
+ my $db_driver;
+ if ($context->config("db_scheme")){
+ $db_driver=db_scheme2dbi($context->config("db_scheme"));
+ }else{
+ $db_driver="mysql";
+ }
+
+ my $db_name = $context->config("database");
+ my $db_host = $context->config("hostname");
+ 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'");
+ return $dbh;
}
=item dbh
possibly C<&set_dbh>.
=cut
+
#'
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"};
connect to so that the caller doesn't have to know.
=cut
+
#'
sub new_dbh
{
C<$my_dbh> is assumed to be a good database handle.
=cut
+
#'
sub set_dbh
{
C<C4::Context-E<gt>set_dbh>.
=cut
+
#'
sub restore_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!).
+sub _new_marcfromkohafield
+{
+ my $dbh = C4::Context->dbh;
+ my $marcfromkohafield;
+ my $sth = $dbh->prepare("select kohafield,tagfield,tagsubfield,recordtype from koha_attr where tagfield is not null ");
+ $sth->execute;
+ while (my ($kohafield,$tagfield,$tagsubfield,$recordtype) = $sth->fetchrow) {
+ my $retval = {};
+ $marcfromkohafield->{$recordtype}->{$kohafield} = [$tagfield,$tagsubfield];
+ }
+
+ return $marcfromkohafield;
+}
+
+
+#item attrfromkohafield
+#To use as a hash of koha to z3950 attributes
+sub _new_attrfromkohafield
+{
+ my $dbh = C4::Context->dbh;
+ my $attrfromkohafield;
+ my $sth2 = $dbh->prepare("select kohafield,attr,extraattr from koha_attr" );
+ $sth2->execute;
+ while (my ($kohafield,$attr,$extra) = $sth2->fetchrow) {
+ my $retval = {};
+ $attrfromkohafield->{$kohafield} = "\@attr 1=".$attr." ".$extra;
+ }
+ return $attrfromkohafield;
+}
+sub attrfromkohafield
+{
+ my $retval = {};
+
+ # If the hash already exists, return it.
+ return $context->{"attrfromkohafield"} if defined($context->{"attrfromkohafield"});
+
+ # No hash. Create one.
+ $context->{"attrfromkohafield"} = &_new_attrfromkohafield();
+
+ return $context->{"attrfromkohafield"};
+}
=item stopwords
$dbh = C4::Context->stopwords;
C<C4::Context-E<gt>stopwords> twice, you will get the same hash without real DB access
=cut
+
#'
sub stopwords
{
my $retval = {};
$stopwordlist->{$stopword} = uc($stopword);
}
+ $stopwordlist->{A} = "A" unless $stopwordlist;
return $stopwordlist;
}
+=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});
+ return 0;
+ warn "NO CONTEXT for $var";
+}
+
+=item set_userenv
+
+ C4::Context->set_userenv($usernum, $userid, $usercnum, $userfirstname, $usersurname, $userbranch, $userflags, $emailaddress);
+
+Informs 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, $branchname, $userflags, $emailaddress,$branchprinter)= @_;
+ my $var=$context->{"activeuser"};
+ my $cell = {
+ "number" => $usernum,
+ "id" => $userid,
+ "cardnumber" => $usercnum,
+# "firstname" => $userfirstname,
+# "surname" => $usersurname,
+#possibly a law problem
+ "branch" => $userbranch,
+ "branchname" => $branchname,
+ "flags" => $userflags,
+ "emailaddress" => $emailaddress,
+ "branchprinter" => $branchprinter,
+ };
+ $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->{"activeuser"} if ($context->{"activeuser"} eq $sessionID);
+}
+
+
+
1;
__END__
Andrew Arensburger <arensb at ooblick dot com>
=cut
+# $Log$
+# Revision 1.47 2006/09/27 19:53:52 tgarip1957
+# Finalizing main components. All koha modules are now working with the new XML API
+#
+# Revision 1.46 2006/09/06 16:21:03 tgarip1957
+# Clean up before final commits
+#
+# Revision 1.43 2006/08/10 12:49:37 toins
+# sync with dev_week.
+#
+# Revision 1.42 2006/07/04 14:36:51 toins
+# Head & rel_2_2 merged
+#
+# Revision 1.41 2006/05/20 14:36:09 tgarip1957
+# Typo error. Missing '>'
+#
+# Revision 1.40 2006/05/20 14:28:02 tgarip1957
+# Adding support to read zebra database name from config files
+#
+# Revision 1.39 2006/05/19 09:52:54 alaurin
+# committing new feature ip and printer management
+# adding two fields in branches table (branchip,branchprinter)
+#
+# branchip : if the library enter an ip or ip range any librarian that connect from computer in this ip range will be temporarly affected to the corresponding branch .
+#
+# branchprinter : the library can select a default printer for a branch
+#
+# Revision 1.38 2006/05/14 00:22:31 tgarip1957
+# Adding support for getting details of different zebra servers
+#
+# Revision 1.37 2006/05/13 19:51:39 tgarip1957
+# Now reads koha.xml rather than koha.conf.
+# koha.xml contains both the koha configuration and zebraserver configuration.
+# Zebra connection is modified to allow connection to authority zebra as well.
+# It will break head if koha.conf is not replaced with koha.xml
+#
+# Revision 1.36 2006/05/09 13:28:08 tipaul
+# adding the branchname and the librarian name in every page :
+# - modified userenv to add branchname
+# - modifier menus.inc to have the librarian name & userenv displayed on every page. they are in a librarian_information div.
+#
+# Revision 1.35 2006/04/13 08:40:11 plg
+# bug fixed: typo on Zconnauth name
+#
+# Revision 1.34 2006/04/10 21:40:23 tgarip1957
+# A new handler defined for zebra Zconnauth with read/write permission. Zconnauth should only be called in biblio.pm where write operations are. Use of this handler will break things unless koha.conf contains new variables:
+# zebradb=localhost
+# zebraport=<your port>
+# zebrauser=<username>
+# zebrapass=<password>
+#
+# The zebra.cfg file should read:
+# perm.anonymous:r
+# perm.username:rw
+# passw.c:<yourpasswordfile>
+#
+# Password file should be prepared with Apaches htpasswd utility in encrypted mode and should exist in a folder zebra.cfg can read
+#
+# Revision 1.33 2006/03/15 11:21:56 plg
+# bug fixed: utf-8 data where not displayed correctly in screens. Supposing
+# your data are truely utf-8 encoded in your database, they should be
+# correctly displayed. "set names 'UTF8'" on mysql connection (C4/Context.pm)
+# is mandatory and "binmode" to utf8 (C4/Interface/CGI/Output.pm) seemed to
+# converted data twice, so it was removed.
+#
+# Revision 1.32 2006/03/03 17:25:01 hdl
+# Bug fixing : a line missed a comment sign.
+#
+# Revision 1.31 2006/03/03 16:45:36 kados
+# Remove the search that tests the Zconn -- warning, still no fault
+# tollerance
+#
+# Revision 1.30 2006/02/22 00:56:59 kados
+# First go at a connection object for Zebra. You can now get a
+# connection object by doing:
+#
+# my $Zconn = C4::Context->Zconn;
+#
+# My initial tests indicate that as soon as your funcion ends
+# (ie, when you're done doing something) the connection will be
+# closed automatically. There may be some other way to make the
+# connection more stateful, I'm not sure...
+#
+# Local Variables:
+# tab-width: 4
+# End: