Code cleaning :
[koha.git] / C4 / Context.pm
index 9c82561..c9fe249 100644 (file)
 # 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);
@@ -42,7 +36,7 @@ C4::Context - Maintain and manipulate the context of a Koha script
 
   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;
@@ -80,6 +74,7 @@ environment variable to the pathname of a configuration file to use.
 =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:
@@ -87,14 +82,16 @@ environment variable to the pathname of a configuration file to use.
 # 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
@@ -118,47 +115,13 @@ $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
@@ -203,6 +166,7 @@ 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
@@ -222,14 +186,18 @@ sub new
                # 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
@@ -255,6 +223,7 @@ sets the context to C<$context>, which will be used in future
 operations. To restore the previous context, use C<&restore_context>.
 
 =cut
+
 #'
 sub set_context
 {
@@ -293,6 +262,7 @@ sub set_context
 Restores the context set by C<&set_context>.
 
 =cut
+
 #'
 sub restore_context
 {
@@ -325,6 +295,7 @@ method names. If there is a configuration variable called "new", then
 C<C4::Config-E<gt>new> will not return it.
 
 =cut
+
 #'
 sub config
 {
@@ -338,9 +309,24 @@ 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");
@@ -350,6 +336,7 @@ 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
@@ -397,17 +384,128 @@ sub AUTOLOAD
        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.
@@ -430,6 +528,7 @@ times. If you need a second database handle, use C<&new_dbh> and
 possibly C<&set_dbh>.
 
 =cut
+
 #'
 sub dbh
 {
@@ -459,6 +558,7 @@ convenience function; the point is that it knows which database to
 connect to so that the caller doesn't have to know.
 
 =cut
+
 #'
 sub new_dbh
 {
@@ -483,6 +583,7 @@ the current database handle to C<$my_dbh>.
 C<$my_dbh> is assumed to be a good database handle.
 
 =cut
+
 #'
 sub set_dbh
 {
@@ -505,6 +606,7 @@ Restores the database handle saved by an earlier call to
 C<C4::Context-E<gt>set_dbh>.
 
 =cut
+
 #'
 sub restore_dbh
 {
@@ -533,6 +635,7 @@ 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
 {
@@ -573,6 +676,7 @@ 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
 {
@@ -616,6 +720,7 @@ C<C4::Context-E<gt>userenv> twice, you will get the same hash without real DB ac
 set_userenv is called in Auth.pm
 
 =cut
+
 #'
 sub userenv
 {
@@ -639,7 +744,7 @@ set_userenv is called in Auth.pm
 =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,
@@ -649,8 +754,10 @@ sub set_userenv{
 #              "surname"    => $usersurname,
 #possibly a law problem
                "branch"     => $userbranch,
+               "branchname" => $branchname,
                "flags"      => $userflags,
                "emailaddress"  => $emailaddress,
+               "branchprinter" => $branchprinter,
        };
        $context->{userenv}->{$var} = $cell;
        return $cell;
@@ -668,6 +775,7 @@ C<C4::Context-E<gt>userenv> twice, you will get the same hash without real DB ac
 _new_userenv is called in Auth.pm
 
 =cut
+
 #'
 sub _new_userenv
 {
@@ -717,3 +825,80 @@ DBI(3)
 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: