Bug 5549 : overdues display should be hours mins aware
[koha.git] / C4 / Context.pm
index 4775351..67d31ee 100644 (file)
@@ -12,53 +12,99 @@ package C4::Context;
 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
 #
-# You should have received a copy of the GNU General Public License along with
-# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
-# Suite 330, Boston, MA  02111-1307 USA
+# You should have received a copy of the GNU General Public License along
+# with Koha; if not, write to the Free Software Foundation, Inc.,
+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
 
 use strict;
-use vars qw($VERSION $AUTOLOAD $context @context_stack);
+use warnings;
+use vars qw($VERSION $AUTOLOAD $context @context_stack $servers $memcached $ismemcached);
 
 BEGIN {
        if ($ENV{'HTTP_USER_AGENT'})    {
                require CGI::Carp;
+        # FIXME for future reference, CGI::Carp doc says
+        #  "Note that fatalsToBrowser does not work with mod_perl version 2.0 and higher."
                import CGI::Carp qw(fatalsToBrowser);
                        sub handle_errors {
-                               my $msg = shift;
-                               my $debug_level =  C4::Context->preference("DebugLevel");
-
+                           my $msg = shift;
+                           my $debug_level;
+                           eval {C4::Context->dbh();};
+                           if ($@){
+                               $debug_level = 1;
+                           } 
+                           else {
+                               $debug_level =  C4::Context->preference("DebugLevel");
+                           }
+
+                print q(<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
+                            "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
+                       <html lang="en" xml:lang="en"  xmlns="http://www.w3.org/1999/xhtml">
+                       <head><title>Koha Error</title></head>
+                       <body>
+                );
                                if ($debug_level eq "2"){
                                        # debug 2 , print extra info too.
                                        my %versions = get_versions();
 
                # a little example table with various version info";
                                        print "
-                                               <h1>debug level $debug_level </h1>
-                                               <p>Got an error: $msg</p>
+                                               <h1>Koha error</h1>
+                                               <p>The following fatal error has occurred:</p> 
+                        <pre><code>$msg</code></pre>
                                                <table>
-                                               <tr><th>Apache<td>  $versions{apacheVersion}</tr>
-                                               <tr><th>Koha<td>    $versions{kohaVersion}</tr>
-                                               <tr><th>MySQL<td>   $versions{mysqlVersion}</tr>
-                                               <tr><th>OS<td>      $versions{osVersion}</tr>
-                                               <tr><th>Perl<td>    $versions{perlVersion}</tr>
+                                               <tr><th>Apache</th><td>  $versions{apacheVersion}</td></tr>
+                                               <tr><th>Koha</th><td>    $versions{kohaVersion}</td></tr>
+                                               <tr><th>Koha DB</th><td> $versions{kohaDbVersion}</td></tr>
+                                               <tr><th>MySQL</th><td>   $versions{mysqlVersion}</td></tr>
+                                               <tr><th>OS</th><td>      $versions{osVersion}</td></tr>
+                                               <tr><th>Perl</th><td>    $versions{perlVersion}</td></tr>
                                                </table>";
 
                                } elsif ($debug_level eq "1"){
-                                       print "<h1>debug level $debug_level </h1>";
-                                       print "<p>Got an error: $msg</p>";
+                                       print "
+                                               <h1>Koha error</h1>
+                                               <p>The following fatal error has occurred:</p> 
+                        <pre><code>$msg</code></pre>";
                                } else {
-                                       print "production mode - trapped fatal";
+                                       print "<p>production mode - trapped fatal error</p>";
                                }       
-                       }       
-               CGI::Carp->set_message(\&handle_errors);
+                print "</body></html>";
+                       }
+               #CGI::Carp::set_message(\&handle_errors);
+               ## give a stack backtrace if KOHA_BACKTRACES is set
+               ## can't rely on DebugLevel for this, as we're not yet connected
+               if ($ENV{KOHA_BACKTRACES}) {
+                       $main::SIG{__DIE__} = \&CGI::Carp::confess;
+               }
     }          # else there is no browser to send fatals to!
-       $VERSION = '3.00.00.036';
+
+    # Check if there are memcached servers set
+    $servers = $ENV{'MEMCACHED_SERVERS'};
+    if ($servers) {
+        # Load required libraries and create the memcached object
+        require Cache::Memcached;
+        $memcached = Cache::Memcached->new({
+        servers => [ $servers ],
+        debug   => 0,
+        compress_threshold => 10_000,
+        expire_time => 600,
+        namespace => $ENV{'MEMCACHED_NAMESPACE'} || 'koha'
+    });
+        # Verify memcached available (set a variable and test the output)
+    $ismemcached = $memcached->set('ismemcached','1');
+    }
+
+    $VERSION = '3.00.00.036';
 }
 
 use DBI;
 use ZOOM;
 use XML::Simple;
 use C4::Boolean;
+use C4::Debug;
+use POSIX ();
+use DateTime::TimeZone;
 
 =head1 NAME
 
@@ -109,8 +155,6 @@ environment variable to the pathname of a configuration file to use.
 
 =head1 METHODS
 
-=over 2
-
 =cut
 
 #'
@@ -158,29 +202,25 @@ $context = undef;        # Initially, no context is set
 @context_stack = ();        # Initially, no saved contexts
 
 
-=item KOHAVERSION
-    returns the kohaversion stored in kohaversion.pl file
+=head2 KOHAVERSION
+
+returns the kohaversion stored in kohaversion.pl file
 
 =cut
 
 sub KOHAVERSION {
-    my $cgidir = C4::Context->intranetdir ."/cgi-bin";
-
-    # 2 cases here : on CVS install, $cgidir does not need a /cgi-bin
-    # on a standard install, /cgi-bin need to be added.
-    # test one, then the other
-    # FIXME - is this all really necessary?
-    unless (opendir(DIR, "$cgidir/cataloguing/value_builder")) {
-        $cgidir = C4::Context->intranetdir;
-        closedir(DIR);
-    }
+    my $cgidir = C4::Context->intranetdir;
 
+    # Apparently the GIT code does not run out of a CGI-BIN subdirectory
+    # but distribution code does?  (Stan, 1jan08)
+    if(-d $cgidir . "/cgi-bin"){
+        my $cgidir .= "/cgi-bin";
+    }
+    
     do $cgidir."/kohaversion.pl" || die "NO $cgidir/kohaversion.pl";
     return kohaversion();
 }
-=item read_config_file
-
-=over 4
+=head2 read_config_file
 
 Reads the specified Koha config file. 
 
@@ -203,43 +243,78 @@ The elements nested within the <server> element:
 
 Returns undef in case of error.
 
-=back
-
 =cut
 
 sub read_config_file {         # Pass argument naming config file to read
-    my $koha = XMLin(shift, keyattr => ['id'], forcearray => ['listen', 'server', 'serverinfo']);
+    my $koha = XMLin(shift, keyattr => ['id'], forcearray => ['listen', 'server', 'serverinfo'], suppressempty => '');
+
+    if ($ismemcached) {
+      $memcached->set('kohaconf',$koha);
+    }
+
     return $koha;                      # Return value: ref-to-hash holding the configuration
 }
 
+=head2 ismemcached
+
+Returns the value of the $ismemcached variable (0/1)
+
+=cut
+
+sub ismemcached {
+    return $ismemcached;
+}
+
+=head2 memcached
+
+If $ismemcached is true, returns the $memcache variable.
+Returns undef otherwise
+
+=cut
+
+sub memcached {
+    if ($ismemcached) {
+      return $memcached;
+    } else {
+      return undef;
+    }
+}
+
 # db_scheme2dbi
 # Translates the full text name of a database into de appropiate dbi name
 # 
 sub db_scheme2dbi {
     my $name = shift;
-
+    # for instance, we support only mysql, so don't care checking
+    return "mysql";
     for ($name) {
 # FIXME - Should have other databases. 
-        if (/mysql/i) { return("mysql"); }
+        if (/mysql/) { return("mysql"); }
         if (/Postgres|Pg|PostgresSQL/) { return("Pg"); }
-        if (/oracle/i) { return("Oracle"); }
+        if (/oracle/) { return("Oracle"); }
     }
     return undef;         # Just in case
 }
 
 sub import {
-    my $package = shift;
-    my $conf_fname = shift;        # Config file name
-    my $context;
-
-    # Create a new context from the given config file name, if
-    # any, then set it as the current context.
-    $context = new C4::Context($conf_fname);
-    return undef if !defined($context);
-    $context->set_context;
+    # Create the default context ($C4::Context::Context)
+    # the first time the module is called
+    # (a config file can be optionaly passed)
+
+    # default context allready exists? 
+    return if $context;
+
+    # no ? so load it!
+    my ($pkg,$config_file) = @_ ;
+    my $new_ctx = __PACKAGE__->new($config_file);
+    return unless $new_ctx;
+
+    # if successfully loaded, use it by default
+    $new_ctx->set_context;
+    1;
 }
 
-=item new
+=head2 new
 
   $context = new C4::Context;
   $context = new C4::Context("/path/to/koha-conf.xml");
@@ -248,6 +323,10 @@ 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/koha-conf.xml>.
 
+It saves the koha-conf.xml values in the declared memcached server(s)
+if currently available and uses those values until them expire and
+re-reads them.
+
 C<&new> does not set this context as the new default context; for
 that, use C<&set_context>.
 
@@ -282,10 +361,20 @@ sub new {
             return undef;
         }
     }
-        # Load the desired config file.
-    $self = read_config_file($conf_fname);
-    $self->{"config_file"} = $conf_fname;
     
+    if ($ismemcached) {
+        # retreive from memcached
+        $self = $memcached->get('kohaconf');
+        if (not defined $self) {
+            # not in memcached yet
+            $self = read_config_file($conf_fname);
+        }
+    } else {
+        # non-memcached env, read from file
+        $self = read_config_file($conf_fname);
+    }
+
+    $self->{"config_file"} = $conf_fname;
     warn "read_config_file($conf_fname) returned undef" if !defined($self->{"config"});
     return undef if !defined($self->{"config"});
 
@@ -296,12 +385,13 @@ sub new {
     $self->{"userenv"} = undef;        # User env
     $self->{"activeuser"} = undef;        # current active user
     $self->{"shelves"} = undef;
+    $self->{tz} = undef; # local timezone object
 
     bless $self, $class;
     return $self;
 }
 
-=item set_context
+=head2 set_context
 
   $context = new C4::Context;
   $context->set_context();
@@ -349,7 +439,7 @@ sub set_context
     $context = $new_context;
 }
 
-=item restore_context
+=head2 restore_context
 
   &restore_context;
 
@@ -375,7 +465,7 @@ sub restore_context
     # that was current when this was called?
 }
 
-=item config
+=head2 config
 
   $value = C4::Context->config("config_variable");
 
@@ -413,34 +503,46 @@ sub ModZebrations {
        return _common_config($_[1],'serverinfo');
 }
 
-=item preference
+=head2 preference
 
-  $sys_preference = C4::Context->preference("some_variable");
+  $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.
+variable is not set or does not exist, undef is returned.
+
+In case of an error, this may return 0.
+
+Note: It is impossible to tell the difference between system
+preferences which do not exist, and those whose values are set to NULL
+with this method.
 
 =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
-{
+# FIXME: running this under mod_perl will require a means of
+# flushing the caching mechanism.
+
+my %sysprefs;
+
+sub preference {
     my $self = shift;
-    my $var = shift;        # The system preference to return
-    my $retval;            # Return value
-    my $dbh = C4::Context->dbh or return 0;
+    my $var  = lc(shift);                          # The system preference to return
+
+    if (exists $sysprefs{$var}) {
+        return $sysprefs{$var};
+    }
+
+    my $dbh  = C4::Context->dbh or return 0;
+
     # Look up systempreferences.variable==$var
-    $retval = $dbh->selectrow_array(<<EOT);
+    my $sql = <<'END_SQL';
         SELECT    value
         FROM    systempreferences
-        WHERE    variable='$var'
+        WHERE    variable=?
         LIMIT    1
-EOT
-    return $retval;
+END_SQL
+    $sysprefs{$var} = $dbh->selectrow_array( $sql, {}, $var );
+    return $sysprefs{$var};
 }
 
 sub boolean_preference ($) {
@@ -450,6 +552,53 @@ sub boolean_preference ($) {
     return defined($it)? C4::Boolean::true_p($it): undef;
 }
 
+=head2 clear_syspref_cache
+
+  C4::Context->clear_syspref_cache();
+
+cleans the internal cache of sysprefs. Please call this method if
+you update the systempreferences table. Otherwise, your new changes
+will not be seen by this process.
+
+=cut
+
+sub clear_syspref_cache {
+    %sysprefs = ();
+}
+
+=head2 set_preference
+
+  C4::Context->set_preference( $variable, $value );
+
+This updates a preference's value both in the systempreferences table and in
+the sysprefs cache.
+
+=cut
+
+sub set_preference {
+    my $self = shift;
+    my $var = lc(shift);
+    my $value = shift;
+
+    my $dbh = C4::Context->dbh or return 0;
+
+    my $type = $dbh->selectrow_array( "SELECT type FROM systempreferences WHERE variable = ?", {}, $var );
+
+    $value = 0 if ( $type && $type eq 'YesNo' && $value eq '' );
+
+    my $sth = $dbh->prepare( "
+      INSERT INTO systempreferences
+        ( variable, value )
+        VALUES( ?, ? )
+        ON DUPLICATE KEY UPDATE value = VALUES(value)
+    " );
+
+    if($sth->execute( $var, $value )) {
+        $sysprefs{$var} = $value;
+    }
+    $sth->finish;
+}
+
 # AUTOLOAD
 # This implements C4::Config->foo, and simply returns
 # C4::Context->config("foo"), as described in the documentation for
@@ -468,9 +617,9 @@ sub AUTOLOAD
     return $self->config($AUTOLOAD);
 }
 
-=item Zconn
+=head2 Zconn
 
-$Zconn = C4::Context->Zconn
+  $Zconn = C4::Context->Zconn
 
 Returns a connection to the Zebra database for the current
 context. If no connection has yet been made, this method 
@@ -511,7 +660,7 @@ sub Zconn {
     }
 }
 
-=item _new_Zconn
+=head2 _new_Zconn
 
 $context->{"Zconn"} = &_new_Zconn($server,$async);
 
@@ -591,37 +740,39 @@ sub _new_Zconn {
 sub _new_dbh
 {
 
-### $context
-    ##correct name for db_schme        
+    ## $context
+    ## correct name for db_schme        
     my $db_driver;
     if ($context->config("db_scheme")){
-    $db_driver=db_scheme2dbi($context->config("db_scheme"));
+        $db_driver=db_scheme2dbi($context->config("db_scheme"));
     }else{
-    $db_driver="mysql";
+        $db_driver="mysql";
     }
 
     my $db_name   = $context->config("database");
     my $db_host   = $context->config("hostname");
-    my $db_port   = $context->config("port");
-    $db_port = "" unless defined $db_port;
+    my $db_port   = $context->config("port") || '';
     my $db_user   = $context->config("user");
     my $db_passwd = $context->config("pass");
     # MJR added or die here, as we can't work without dbh
     my $dbh= DBI->connect("DBI:$db_driver:dbname=$db_name;host=$db_host;port=$db_port",
-         $db_user, $db_passwd) or die $DBI::errstr;
+    $db_user, $db_passwd, {'RaiseError' => $ENV{DEBUG}?1:0 }) or die $DBI::errstr;
+       my $tz = $ENV{TZ};
     if ( $db_driver eq 'mysql' ) { 
         # 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->{'mysql_enable_utf8'}=1; #enable
         $dbh->do("set NAMES 'utf8'");
+        ($tz) and $dbh->do(qq(SET time_zone = "$tz"));
     }
     elsif ( $db_driver eq 'Pg' ) {
            $dbh->do( "set client_encoding = 'UTF8';" );
+        ($tz) and $dbh->do(qq(SET TIME ZONE = "$tz"));
     }
     return $dbh;
 }
 
-=item dbh
+=head2 dbh
 
   $dbh = C4::Context->dbh;
 
@@ -642,9 +793,8 @@ sub dbh
     my $self = shift;
     my $sth;
 
-    if (defined($context->{"dbh"})) {
-        $sth=$context->{"dbh"}->prepare("select 1");
-        return $context->{"dbh"} if (defined($sth->execute));
+    if (defined($context->{"dbh"}) && $context->{"dbh"}->ping()) {
+       return $context->{"dbh"};
     }
 
     # No database handle or it died . Create one.
@@ -653,7 +803,7 @@ sub dbh
     return $context->{"dbh"};
 }
 
-=item new_dbh
+=head2 new_dbh
 
   $dbh = C4::Context->new_dbh;
 
@@ -674,7 +824,7 @@ sub new_dbh
     return &_new_dbh();
 }
 
-=item set_dbh
+=head2 set_dbh
 
   $my_dbh = C4::Connect->new_dbh;
   C4::Connect->set_dbh($my_dbh);
@@ -705,7 +855,7 @@ sub set_dbh
     $context->{"dbh"} = $new_dbh;
 }
 
-=item restore_dbh
+=head2 restore_dbh
 
   C4::Context->restore_dbh;
 
@@ -732,7 +882,7 @@ sub restore_dbh
     # return something, then this function should, too.
 }
 
-=item marcfromkohafield
+=head2 marcfromkohafield
 
   $dbh = C4::Context->marcfromkohafield;
 
@@ -773,7 +923,7 @@ sub _new_marcfromkohafield
     return $marcfromkohafield;
 }
 
-=item stopwords
+=head2 stopwords
 
   $dbh = C4::Context->stopwords;
 
@@ -808,33 +958,29 @@ sub _new_stopwords
     my $sth = $dbh->prepare("select word from stopwords");
     $sth->execute;
     while (my $stopword = $sth->fetchrow_array) {
-        my $retval = {};
         $stopwordlist->{$stopword} = uc($stopword);
     }
     $stopwordlist->{A} = "A" unless $stopwordlist;
     return $stopwordlist;
 }
 
-=item userenv
+=head2 userenv
 
   C4::Context->userenv;
 
-Builds a hash for user environment variables.
+Retrieves 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
-{
+sub userenv {
     my $var = $context->{"activeuser"};
-    return $context->{"userenv"}->{$var} if (defined $context->{"userenv"}->{$var});
+    return $context->{"userenv"}->{$var} if (defined $var and defined $context->{"userenv"}->{$var});
     # insecure=1 management
-    if ($context->{"dbh"} && $context->preference('insecure')) {
+    if ($context->{"dbh"} && $context->preference('insecure') eq 'yes') {
         my %insecure;
         $insecure{flags} = '16382';
         $insecure{branchname} ='Insecure';
@@ -845,25 +991,23 @@ sub userenv
         $insecure{emailaddress} = 'test@mode.insecure.com';
         return \%insecure;
     } else {
-        return 0;
+        return;
     }
 }
 
-=item set_userenv
+=head2 set_userenv
 
-  C4::Context->set_userenv($usernum, $userid, $usercnum, $userfirstname, $usersurname, $userbranch, $userflags, $emailaddress);
+  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
+Establish a hash of user environment variables.
 
 set_userenv is called in Auth.pm
 
 =cut
 
 #'
-sub set_userenv{
+sub set_userenv {
     my ($usernum, $userid, $usercnum, $userfirstname, $usersurname, $userbranch, $branchname, $userflags, $emailaddress, $branchprinter)= @_;
     my $var=$context->{"activeuser"};
     my $cell = {
@@ -872,36 +1016,40 @@ sub set_userenv{
         "cardnumber" => $usercnum,
         "firstname"  => $userfirstname,
         "surname"    => $usersurname,
-#possibly a law problem
+        #possibly a law problem
         "branch"     => $userbranch,
         "branchname" => $branchname,
         "flags"      => $userflags,
-        "emailaddress"    => $emailaddress,
-               "branchprinter"    => $branchprinter
+        "emailaddress"     => $emailaddress,
+        "branchprinter"    => $branchprinter
     };
     $context->{userenv}->{$var} = $cell;
     return $cell;
 }
 
-sub set_shelves_userenv ($) {
-       my $lists = shift or return undef;
+sub set_shelves_userenv ($$) {
+       my ($type, $shelves) = @_ or return undef;
        my $activeuser = $context->{activeuser} or return undef;
-       $context->{userenv}->{$activeuser}->{shelves} = $lists;
-       # die "set_shelves_userenv: $lists";
+       $context->{userenv}->{$activeuser}->{barshelves} = $shelves if $type eq 'bar';
+       $context->{userenv}->{$activeuser}->{pubshelves} = $shelves if $type eq 'pub';
+       $context->{userenv}->{$activeuser}->{totshelves} = $shelves if $type eq 'tot';
 }
+
 sub get_shelves_userenv () {
        my $active;
        unless ($active = $context->{userenv}->{$context->{activeuser}}) {
-               warn "get_shelves_userenv cannot retrieve context->{userenv}->{context->{activeuser}}";
+               $debug and warn "get_shelves_userenv cannot retrieve context->{userenv}->{context->{activeuser}}";
                return undef;
        }
-       my $lists = $active->{shelves} or return undef;#  die "get_shelves_userenv: activeenv has no ->{shelves}";
-       return $lists;
+       my $totshelves = $active->{totshelves} or undef;
+       my $pubshelves = $active->{pubshelves} or undef;
+       my $barshelves = $active->{barshelves} or undef;
+       return ($totshelves, $pubshelves, $barshelves);
 }
 
-=item _new_userenv
+=head2 _new_userenv
 
-  C4::Context->_new_userenv($session);
+  C4::Context->_new_userenv($session);  # FIXME: This calling style is wrong for what looks like an _internal function
 
 Builds a hash for user environment variables.
 
@@ -915,12 +1063,12 @@ _new_userenv is called in Auth.pm
 #'
 sub _new_userenv
 {
-    shift;
+    shift;  # Useless except it compensates for bad calling style
     my ($sessionID)= @_;
      $context->{"activeuser"}=$sessionID;
 }
 
-=item _unset_userenv
+=head2 _unset_userenv
 
   C4::Context->_unset_userenv;
 
@@ -937,7 +1085,7 @@ sub _unset_userenv
 }
 
 
-=item get_versions
+=head2 get_versions
 
   C4::Context->get_versions
 
@@ -950,33 +1098,49 @@ Gets various version info, for core Koha packages, Currently called from carp ha
 # A little example sub to show more debugging info for CGI::Carp
 sub get_versions {
     my %versions;
-    $versions{kohaVersion}  = C4::Context->config("kohaversion");
-    $versions{osVersion} = `uname -a`;
+    $versions{kohaVersion}  = KOHAVERSION();
+    $versions{kohaDbVersion} = C4::Context->preference('version');
+    $versions{osVersion} = join(" ", POSIX::uname());
     $versions{perlVersion} = $];
-    $versions{mysqlVersion} = `mysql -V`;
-    $versions{apacheVersion} =  `httpd -v`;
-    $versions{apacheVersion} =  `httpd2 -v`            unless  $versions{apacheVersion} ;
-    $versions{apacheVersion} =  `apache2 -v`           unless  $versions{apacheVersion} ;
-    $versions{apacheVersion} =  `/usr/sbin/apache2 -v` unless  $versions{apacheVersion} ;
+    {
+        no warnings qw(exec); # suppress warnings if unable to find a program in $PATH
+        $versions{mysqlVersion}  = `mysql -V`;
+        $versions{apacheVersion} = `httpd -v`;
+        $versions{apacheVersion} = `httpd2 -v`            unless  $versions{apacheVersion} ;
+        $versions{apacheVersion} = `apache2 -v`           unless  $versions{apacheVersion} ;
+        $versions{apacheVersion} = `/usr/sbin/apache2 -v` unless  $versions{apacheVersion} ;
+    }
     return %versions;
 }
 
 
+=head2 tz
+
+  C4::Context->tz
+
+  Returns a DateTime::TimeZone object for the system timezone
+
+=cut
+
+sub tz {
+    my $self = shift;
+    if (!defined $context->{tz}) {
+        $context->{tz} = DateTime::TimeZone->new(name => 'local');
+    }
+    return $context->{tz};
+}
+
+
+
 1;
 __END__
 
-=back
-
 =head1 ENVIRONMENT
 
-=over 4
-
-=item C<KOHA_CONF>
+=head2 C<KOHA_CONF>
 
 Specifies the configuration file to read.
 
-=back
-
 =head1 SEE ALSO
 
 XML::Simple
@@ -988,217 +1152,3 @@ Andrew Arensburger <arensb at ooblick dot com>
 Joshua Ferraro <jmf at liblime dot com>
 
 =cut
-
-# Revision 1.57  2007/05/22 09:13:55  tipaul
-# Bugfixes & improvements (various and minor) :
-# - updating templates to have tmpl_process3.pl running without any errors
-# - adding a drupal-like css for prog templates (with 3 small images)
-# - fixing some bugs in circulation & other scripts
-# - updating french translation
-# - fixing some typos in templates
-#
-# Revision 1.56  2007/04/23 15:21:17  tipaul
-# renaming currenttransfers to transferstoreceive
-#
-# Revision 1.55  2007/04/17 08:48:00  tipaul
-# circulation cleaning continued: bufixing
-#
-# Revision 1.54  2007/03/29 16:45:53  tipaul
-# Code cleaning of Biblio.pm (continued)
-#
-# All subs have be cleaned :
-# - removed useless
-# - merged some
-# - reordering Biblio.pm completly
-# - using only naming conventions
-#
-# Seems to have broken nothing, but it still has to be heavily tested.
-# Note that Biblio.pm is now much more efficient than previously & probably more reliable as well.
-#
-# Revision 1.53  2007/03/29 13:30:31  tipaul
-# Code cleaning :
-# == Biblio.pm cleaning (useless) ==
-# * some sub declaration dropped
-# * removed modbiblio sub
-# * removed moditem sub
-# * removed newitems. It was used only in finishrecieve. Replaced by a TransformKohaToMarc+AddItem, that is better.
-# * removed MARCkoha2marcItem
-# * removed MARCdelsubfield declaration
-# * removed MARCkoha2marcBiblio
-#
-# == Biblio.pm cleaning (naming conventions) ==
-# * MARCgettagslib renamed to GetMarcStructure
-# * MARCgetitems renamed to GetMarcItem
-# * MARCfind_frameworkcode renamed to GetFrameworkCode
-# * MARCmarc2koha renamed to TransformMarcToKoha
-# * MARChtml2marc renamed to TransformHtmlToMarc
-# * MARChtml2xml renamed to TranformeHtmlToXml
-# * zebraop renamed to ModZebra
-#
-# == MARC=OFF ==
-# * removing MARC=OFF related scripts (in cataloguing directory)
-# * removed checkitems (function related to MARC=off feature, that is completly broken in head. If someone want to reintroduce it, hard work coming...)
-# * removed getitemsbybiblioitem (used only by MARC=OFF scripts, that is removed as well)
-#
-# Revision 1.52  2007/03/16 01:25:08  kados
-# Using my precrash CVS copy I did the following:
-#
-# cvs -z3 -d:ext:kados@cvs.savannah.nongnu.org:/sources/koha co -P koha
-# find koha.precrash -type d -name "CVS" -exec rm -v {} \;
-# cp -r koha.precrash/* koha/
-# cd koha/
-# cvs commit
-#
-# This should in theory put us right back where we were before the crash
-#
-# Revision 1.52  2007/03/12 21:17:05  rych
-# add server, serverinfo as arrays from config
-#
-# Revision 1.51  2007/03/09 14:31:47  tipaul
-# rel_3_0 moved to HEAD
-#
-# Revision 1.43.2.10  2007/02/09 17:17:56  hdl
-# Managing a little better database absence.
-# (preventing from BIG 550)
-#
-# Revision 1.43.2.9  2006/12/20 16:50:48  tipaul
-# improving "insecure" management
-#
-# WARNING KADOS :
-# you told me that you had some libraries with insecure=ON (behind a firewall).
-# In this commit, I created a "fake" user when insecure=ON. It has a fake branch. You may find better to have the 1st branch in branch table instead of a fake one.
-#
-# Revision 1.43.2.8  2006/12/19 16:48:16  alaurin
-# reident programs, and adding branchcode value in reserves
-#
-# Revision 1.43.2.7  2006/12/06 21:55:38  hdl
-# Adding ModZebrations for servers to get serverinfos in Context.pm
-# Using this function in rebuild_zebra.pl
-#
-# Revision 1.43.2.6  2006/11/24 21:18:31  kados
-# very minor changes, no functional ones, just comments, etc.
-#
-# Revision 1.43.2.5  2006/10/30 13:24:16  toins
-# fix some minor POD error.
-#
-# Revision 1.43.2.4  2006/10/12 21:42:49  hdl
-# Managing multiple zebra connections
-#
-# Revision 1.43.2.3  2006/10/11 14:27:26  tipaul
-# removing a warning
-#
-# Revision 1.43.2.2  2006/10/10 15:28:16  hdl
-# BUG FIXING : using database name in Zconn if defined and not hard coded value
-#
-# Revision 1.43.2.1  2006/10/06 13:47:28  toins
-# Synch with dev_week.
-#  /!\ WARNING :: Please now use the new version of koha.xml.
-#
-# Revision 1.18.2.5.2.14  2006/09/24 15:24:06  kados
-# remove Zebraauth routine, fold the functionality into Zconn
-# Zconn can now take several arguments ... this will probably
-# change soon as I'm not completely happy with the readability
-# of the current format ... see the POD for details.
-#
-# cleaning up Biblio.pm, removing unnecessary routines.
-#
-# DeleteBiblio - used to delete a biblio from zebra and koha tables
-#     -- checks to make sure there are no existing issues
-#     -- saves backups of biblio,biblioitems,items in deleted* tables
-#     -- does commit operation
-#
-# getRecord - used to retrieve one record from zebra in piggyback mode using biblionumber
-# brought back z3950_extended_services routine
-#
-# Lots of modifications to Context.pm, you can now store user and pass info for
-# multiple servers (for federated searching) using the <serverinfo> element.
-# I'll commit my koha.xml to demonstrate this or you can refer to the POD in
-# Context.pm (which I also expanded on).
-#
-# Revision 1.18.2.5.2.13  2006/08/10 02:10:21  kados
-# Turned warnings on, and running a search turned up lots of warnings.
-# Cleaned up those ...
-#
-# removed getitemtypes from Koha.pm (one in Search.pm looks newer)
-# removed itemcount from Biblio.pm
-#
-# made some local subs local with a _ prefix (as they were redefined
-# elsewhere)
-#
-# Add two new search subs to Search.pm the start of a new search API
-# that's a bit more scalable
-#
-# Revision 1.18.2.5.2.10  2006/07/21 17:50:51  kados
-# moving the *.properties files to intranetdir/etc dir
-#
-# Revision 1.18.2.5.2.9  2006/07/17 08:05:20  tipaul
-# there was a hardcoded link to /koha/etc/ I replaced it with intranetdir config value
-#
-# Revision 1.18.2.5.2.8  2006/07/11 12:20:37  kados
-# adding ccl and cql files ... Tumer, if you want to fit these into the
-# config file by all means do.
-#
-# Revision 1.18.2.5.2.7  2006/06/04 22:50:33  tgarip1957
-# We do not hard code cql2rpn conversion file in context.pm our koha.xml configuration file already describes the path for this file.
-# At cql searching we use method CQL not CQL2RPN as the cql2rpn conversion file is defined at server level
-#
-# Revision 1.18.2.5.2.6  2006/06/02 23:11:24  kados
-# Committing my working dev_week. It's been tested only with
-# searching, and there's quite a lot of config stuff to set up
-# beforehand. As things get closer to a release, we'll be making
-# some scripts to do it for us
-#
-# Revision 1.18.2.5.2.5  2006/05/28 18:49:12  tgarip1957
-# This is an unusual commit. The main purpose is a working model of Zebra on a modified rel2_2.
-# Any questions regarding these commits should be asked to Joshua Ferraro unless you are Joshua whom I'll report to
-#
-# 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: