@@ -, +, @@ - set an environment variable KOHA_LOG in your virtual host: SetEnv KOHA_LOG /home/koha/var/log/opac.log - set a write flag for www-data on this file Please have a look at t/Logger.t for more details. controlled by the system preference LogToHtmlComments\ --- C4/Auth.pm | 3 + C4/Context.pm | 28 +++ C4/Installer/PerlDependencies.pm | 7 +- Koha/Utils/Logger.pm | 186 ++++++++++++++++++++ install_misc/debian.packages | 1 + installer/data/mysql/sysprefs.sql | 2 + installer/data/mysql/updatedatabase.pl | 13 +- .../prog/en/includes/doc-head-open.inc | 5 + .../prog/en/modules/admin/preferences/admin.pref | 20 +++ opac/opac-search.pl | 4 + t/Logger.t | 95 ++++++++++ 11 files changed, 362 insertions(+), 2 deletions(-) create mode 100644 Koha/Utils/Logger.pm create mode 100644 t/Logger.t --- a/C4/Auth.pm +++ a/C4/Auth.pm @@ -364,6 +364,8 @@ sub get_template_and_user { OPACLocalCoverImages => C4::Context->preference('OPACLocalCoverImages'), AllowMultipleCovers => C4::Context->preference('AllowMultipleCovers'), EnableBorrowerFiles => C4::Context->preference('EnableBorrowerFiles'), + LogToHtmlComments => C4::Context->preference('LogToHtmlComments'), + Logger => C4::Context->logger(), ); } else { @@ -468,6 +470,7 @@ sub get_template_and_user { $template->param(OpacPublic => '1') if ($user || C4::Context->preference("OpacPublic")); } + return ( $template, $borrowernumber, $cookie, $flags); } --- a/C4/Context.pm +++ a/C4/Context.pm @@ -20,6 +20,8 @@ use strict; use warnings; use vars qw($VERSION $AUTOLOAD $context @context_stack $servers $memcached $ismemcached); +use Koha::Utils::Logger; + BEGIN { if ($ENV{'HTTP_USER_AGENT'}) { require CGI::Carp; @@ -1189,6 +1191,32 @@ sub tz { return $context->{tz}; } +=head2 logger + + $logger = C4::Context->logger; + +Returns a Koha logger. If no logger has yet been instantiated, +this method creates one, and caches it. + +=cut + +sub logger +{ + my $self = shift; + my $sth; + + if ( defined( $context->{"logger"} ) ) { + return $context->{"logger"}; + } + + $context->{"logger"} = Koha::Utils::Logger->new( + { + level => C4::Context->preference("LogLevel") + } + ); + + return $context->{"logger"}; +} 1; --- a/C4/Installer/PerlDependencies.pm +++ a/C4/Installer/PerlDependencies.pm @@ -628,12 +628,17 @@ our $PERL_DEPS = { 'usage' => 'Core', 'required' => '0', 'min_ver' => '1.09', - }, + }, 'String::Random' => { 'usage' => 'OpacSelfRegistration', 'required' => '0', 'min_ver' => '0.22', }, + 'Log::LogLite' => { + usage => 'Core', + required => '1', + min_ver => '0.82', + }, }; 1; --- a/Koha/Utils/Logger.pm +++ a/Koha/Utils/Logger.pm @@ -0,0 +1,186 @@ +package Koha::Utils::Logger; + +# Copyright 2012 Biblibre SARL +# +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 2 of the License, or (at your option) any later +# version. +# +# Koha is distributed in the hope that it will be useful, but WITHOUT ANY +# 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., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +use Modern::Perl; +use Log::LogLite; + +use base 'Exporter'; +our @EXPORT_OK = qw($log); + +my $UNUSABLE_LOG_LEVEL = 1; +my $CRITICAL_LOG_LEVEL = 2; +my $ERROR_LOG_LEVEL = 3; +my $WARNING_LOG_LEVEL = 4; +my $NORMAL_LOG_LEVEL = 5; +my $INFO_LOG_LEVEL = 6; +my $DEBUG_LOG_LEVEL = 7; + +my $LEVEL_STR = { + $UNUSABLE_LOG_LEVEL => 'UNUS ', + $CRITICAL_LOG_LEVEL => 'CRIT ', + $ERROR_LOG_LEVEL => 'ERROR ', + $WARNING_LOG_LEVEL => 'WARN ', + $NORMAL_LOG_LEVEL => 'NORMAL', + $INFO_LOG_LEVEL => 'INFO ', + $DEBUG_LOG_LEVEL => 'DEBUG ', +}; + +use Data::Dumper; + +our $log = undef; + +sub new { + my ( $proto, $params ) = @_; + + return $log + if $log + and ( not defined $params->{file} + or not defined $log->{FILE_PATH} + or $params->{file} eq $log->{FILE_PATH} ); + my $class = ref($proto) || $proto; + my $self = {}; + my $LOG_PATH = defined $ENV{KOHA_LOG} ? $ENV{KOHA_LOG} : undef; + $self->{FILE_PATH} = defined $params->{file} ? $params->{file} : $LOG_PATH; + $self->{LEVEL} = defined $params->{level} ? $params->{level} : $INFO_LOG_LEVEL; + $self->{LOGGED_MESSAGES} = []; + + if ( not defined $self->{FILE_PATH} ) { + return bless( $self, $class ); + } + eval { $self->{LOGGER} = Log::LogLite->new( $self->{FILE_PATH}, $self->{LEVEL} ); }; + die "Log system is not correctly configured ($@)" if $@; + return bless( $self, $class ); +} + +sub write { + my ( $self, $msg, $log_level, $dump, $cb ) = @_; + + if ( not $self->{LOGGER} ) { + if ( $log_level <= $self->{LEVEL} ) { + print STDERR "[" . localtime() . "] " . "$LEVEL_STR->{$log_level}: " . $msg . ( $cb ? " (" . $cb . ")" : "" ) . "\n"; + } + return; + } + my $template = "[] $LEVEL_STR->{$log_level}: "; + $template .= " (caller: $cb)" if $cb; + $template .= "\n"; + $self->{LOGGER}->template($template); + $msg = "\n" . Dumper $msg if $dump; + $self->{LOGGER}->write( $msg, $log_level ); + + if ( $log_level <= $self->{LEVEL} ) { + my $message = "[" . localtime() . "] " . "$LEVEL_STR->{$log_level}: " . $msg . ( $cb ? " (" . $cb . ")" : "" ) . "\n"; + push( @{ $self->{LOGGED_MESSAGES} }, $message ); + } +} + +sub unusable { + my ( $self, $msg, $dump ) = @_; + my $cb = $self->called_by(); + $self->write( $msg, $UNUSABLE_LOG_LEVEL, $dump, $cb ); +} + +sub critical { + my ( $self, $msg, $dump ) = @_; + my $cb = $self->called_by(); + $self->write( $msg, $CRITICAL_LOG_LEVEL, $dump, $cb ); +} + +sub error { + my ( $self, $msg, $dump ) = @_; + my $cb = $self->called_by(); + $self->write( $msg, $ERROR_LOG_LEVEL, $dump, $cb ); +} + +sub warning { + my ( $self, $msg, $dump ) = @_; + my $cb = $self->called_by(); + $self->write( $msg, $WARNING_LOG_LEVEL, $dump, $cb ); +} + +sub log { + my ( $self, $msg, $dump ) = @_; + $self->write( $msg, $NORMAL_LOG_LEVEL, $dump ); +} + +sub normal { + my ( $self, $msg, $dump ) = @_; + $self->write( $msg, $NORMAL_LOG_LEVEL, $dump ); +} + +sub info { + my ( $self, $msg, $dump ) = @_; + $self->write( $msg, $INFO_LOG_LEVEL, $dump ); +} + +sub debug { + my ( $self, $msg, $dump ) = @_; + $self->write( $msg, $DEBUG_LOG_LEVEL, $dump ); +} + +sub level { + my $self = shift; + + return $self->{LOGGER} + ? $self->{LOGGER}->level(@_) + : ( $self->{LEVEL} = @_ ? shift : $self->{LEVEL} ); +} + +sub called_by { + my $self = shift; + my $depth = 2; + my $args; + my $pack; + my $file; + my $line; + my $subr; + my $has_args; + my $wantarray; + my $evaltext; + my $is_require; + my $hints; + my $bitmask; + my @subr; + my $str = ""; + + while (1) { + ( $pack, $file, $line, $subr, $has_args, $wantarray, $evaltext, $is_require, $hints, $bitmask ) = caller($depth); + unless ( defined($subr) ) { + last; + } + $depth++; + $line = (3) ? "$file:" . $line . "-->" : ""; + push( @subr, $line . $subr ); + } + @subr = reverse(@subr); + foreach my $sr (@subr) { + $str .= $sr; + $str .= " > "; + } + $str =~ s/ > $/: /; + return $str; +} # of called_by + +sub get_messages { + my $self = shift; + + return $self->{LOGGED_MESSAGES}; +} + +1; --- a/install_misc/debian.packages +++ a/install_misc/debian.packages @@ -64,6 +64,7 @@ liblist-moreutils-perl install liblocale-currency-format-perl install liblocale-gettext-perl install liblocale-po-perl install +liblog-loglite-perl install libmail-sendmail-perl install libmarc-charset-perl install libmarc-crosswalk-dublincore-perl install --- a/installer/data/mysql/sysprefs.sql +++ a/installer/data/mysql/sysprefs.sql @@ -406,3 +406,5 @@ INSERT INTO systempreferences (variable,value,explanation,options,type) VALUES(' INSERT INTO systempreferences (variable,value,explanation,options,type) VALUES('NotesBlacklist','','List of notes fields that should not appear in the title notes/description separator of details',NULL,'free'); INSERT INTO systempreferences (variable,value,options,explanation,type) VALUES ('SCOUserCSS', '', NULL, 'Add CSS to be included in the SCO module in an embedded