# 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 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;
=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
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;
- }
- $retval->{$1} = $value;
- }
- }
- close CONF;
-
- return $retval;
+ return $koha;
}
# db_scheme2dbi
that, use C<&set_context>.
=cut
+
#'
# Revision History:
# 2004-08-10 A. Tarallo: Added check if the conf file is not empty
# that. Otherwise, use the built-in default.
$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->{"userenv"} = undef; # User env
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 $Zconn;
+ if (defined($context->{"Zconn"})) {
+ $Zconn = $context->{"Zconn"};
+ return $context->{"Zconn"};
+ } else {
+ $context->{"Zconn"} = &new_Zconn($server);
+ return $context->{"Zconn"};
+ }
+}
+
+sub Zconnauth {
+ my $self = shift;
+my $server=shift;
+ my $Zconnauth;
+ if (defined($context->{"Zconnauth"})) {
+ $Zconnauth = $context->{"Zconnauth"};
+ return $context->{"Zconnauth"};
+ } else {
+ $context->{"Zconnauth"} = &new_Zconnauth($server);
+ 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 $tried=0;
+my $Zconn;
+my ($tcp,$host,$port)=split /:/,$context->{"listen"}->{$server}->{"content"};
+
+retry:
+ eval {
+ $Zconn=new ZOOM::Connection($context->config("hostname"),$port,databaseName=>$context->{"config"}->{$server},
+ preferredRecordSyntax => "USmarc",elementSetName=> "F");
+ };
+ if ($@){
+###Uncomment the lines below if you want to automatically restart your zebra if its stop
+###The system call is for Windows it should be changed to unix deamon starting for Unix platforms
+# if ($@->code==10000 && $tried==0){ ##No connection try restarting Zebra
+# $tried==1;
+# my $res=system('sc start "Z39.50 Server" >c:/zebraserver/error.log');
+# goto "retry";
+# }else{
+ warn "Error ", $@->code(), ": ", $@->message(), "\n";
+ $Zconn="error";
+ return $Zconn;
+# }
+ }
+
+ return $Zconn;
+}
+
+## Zebra handler with write permission
+sub new_Zconnauth {
+use ZOOM;
+my $server=shift;
+my $tried=0;
+my $Zconnauth;
+my ($tcp,$host,$port)=split /:/,$context->{"listen"}->{$server}->{"content"};
+retry:
+eval{
+ $Zconnauth=new ZOOM::Connection($context->config("hostname"),$port,databaseName=>$context->{"config"}->{$server},
+ user=>$context->{"config"}->{"zebrauser"},
+ password=>$context->{"config"}->{"zebrapass"},preferredRecordSyntax => "USmarc",elementSetName=> "F");
+};
+ if ($@){
+###Uncomment the lines below if you want to automatically restart your zebra if its stop
+###The system call is for Windows it should be changed to unix deamon starting for Unix platforms
+# if ($@->code==10000 && $tried==0){ ##No connection try restarting Zebra
+# $tried==1;
+# my $res=system('sc start "Z39.50 Server" >c:/zebraserver/error.log');
+# goto "retry";
+# }else{
+ warn "Error ", $@->code(), ": ", $@->message(), "\n";
+ $Zconnauth="error";
+ return $Zconnauth;
+# }
+ }
+ 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";
- my $db_name = $context->{"config"}{"database"};
- my $db_host = $context->{"config"}{"hostname"};
- my $db_user = $context->{"config"}{"user"};
- my $db_passwd = $context->{"config"}{"pass"};
+ ##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.
possibly C<&set_dbh>.
=cut
+
#'
sub 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
{
C<C4::Context-E<gt>marcfromkohafield> twice, you will get the same hash without real DB access
=cut
+
#'
sub marcfromkohafield
{
C<C4::Context-E<gt>stopwords> twice, you will get the same hash without real DB access
=cut
+
#'
sub stopwords
{
set_userenv is called in Auth.pm
=cut
+
#'
sub userenv
{
=cut
#'
sub set_userenv{
- my ($usernum, $userid, $usercnum, $userfirstname, $usersurname, $userbranch, $userflags, $emailaddress)= @_;
+ my ($usernum, $userid, $usercnum, $userfirstname, $usersurname, $userbranch, $branchname, $userflags, $emailaddress,$branchprinter)= @_;
my $var=$context->{"activeuser"};
my $cell = {
"number" => $usernum,
# "surname" => $usersurname,
#possibly a law problem
"branch" => $userbranch,
+ "branchname" => $branchname,
"flags" => $userflags,
"emailaddress" => $emailaddress,
+ "branchprinter" => $branchprinter,
};
$context->{userenv}->{$var} = $cell;
return $cell;
_new_userenv is called in Auth.pm
=cut
+
#'
sub _new_userenv
{
Andrew Arensburger <arensb at ooblick dot com>
=cut
+# $Log$
+# 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: