From 77748c2b01d61311d40ffad0201ccd660d211237 Mon Sep 17 00:00:00 2001 From: Jonathan Druart Date: Tue, 5 Jun 2012 15:51:06 +0200 Subject: [PATCH] Bug 8190: Koha::Utils::Logger, Logging module use Koha::Utils::Logger qw/$log/; $log = Koha::Utils::Logger->new; $log->debug("This is a debug message"); $log->info("This is an information"); $log->error("This is an error !"); The Logger constructor can take an hash reference with "file" and "level" to define a filepath or a log level. For a log level >= warning, a call stack is printed. Prerequisite: - 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. Signed-off-by: Mason James Signed-off-by: Kyle M Hall Bug 8190: Followup Logger: FIX perlcritic Signed-off-by: Mason James Signed-off-by: Kyle M Hall Bug 8190 - Followup - Add cached logger, output messages to template * Add C4::Context->logger * Embed logged messageds to a comment in the template html, controlled by the system preference LogToHtmlComments\ * Add both new system preferences to sysprefs.sql Signed-off-by: Paul Poulain Bug 8190 follow-up moving updatedatabase part at the right place Signed-off-by: Kyle M Hall --- C4/Auth.pm | 3 + C4/Context.pm | 28 +++ C4/Installer/PerlDependencies.pm | 5 + 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, 361 insertions(+), 1 deletions(-) create mode 100644 Koha/Utils/Logger.pm create mode 100644 t/Logger.t diff --git a/C4/Auth.pm b/C4/Auth.pm index 705eda0..7a3c44b 100644 --- a/C4/Auth.pm +++ b/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 { @@ -466,6 +468,7 @@ sub get_template_and_user { $template->param(OpacPublic => '1') if ($user || C4::Context->preference("OpacPublic")); } + return ( $template, $borrowernumber, $cookie, $flags); } diff --git a/C4/Context.pm b/C4/Context.pm index bd1f235..04b9b71 100644 --- a/C4/Context.pm +++ b/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; @@ -1177,6 +1179,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; diff --git a/C4/Installer/PerlDependencies.pm b/C4/Installer/PerlDependencies.pm index 71f35d4..fd47717 100644 --- a/C4/Installer/PerlDependencies.pm +++ b/C4/Installer/PerlDependencies.pm @@ -629,6 +629,11 @@ our $PERL_DEPS = { 'required' => '0', 'min_ver' => '1.09', }, + 'Log::LogLite' => { + usage => 'Core', + required => '1', + min_ver => '0.82', + }, }; 1; diff --git a/Koha/Utils/Logger.pm b/Koha/Utils/Logger.pm new file mode 100644 index 0000000..e3937fc --- /dev/null +++ b/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; diff --git a/install_misc/debian.packages b/install_misc/debian.packages index 2460555..2946e16 100644 --- a/install_misc/debian.packages +++ b/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 diff --git a/installer/data/mysql/sysprefs.sql b/installer/data/mysql/sysprefs.sql index 0cc5a54..386dc95 100644 --- a/installer/data/mysql/sysprefs.sql +++ b/installer/data/mysql/sysprefs.sql @@ -388,3 +388,5 @@ INSERT INTO systempreferences (variable, value, options, explanation, type) VALU INSERT INTO systempreferences (variable,value,explanation,options,type) VALUES('HoldsToPullStartDate','2','Set the default start date for the Holds to pull list to this many days ago',NULL,'Integer'); INSERT INTO systempreferences (variable,value,explanation,options,type) VALUES('alphabet','A B C D E F G H I J K L M N O P Q R S T U V W X Y Z','Alphabet than can be expanded into browse links, e.g. on Home > Patrons',NULL,'free'); INSERT INTO systempreferences (variable,value,explanation,options,type) VALUES('RefundLostItemFeeOnReturn', '1', 'If enabled, the lost item fee charged to a borrower will be refunded when the lost item is returned.', NULL, 'YesNo'); +INSERT INTO systempreferences (variable,value,explanation,options,type) VALUES ('LogLevel','5','Set the level of logs. 1=Unusable, 2=Critical, 3=Error, 4=Warning, 5=Normal, 6=Info, 7=Debug','1|2|3|4|5|6|7','Choice'); +INSERT INTO systempreferences (variable,value,explanation,options,type) VALUES ('LogToHtmlComments','0','Embed the logs into the html as a comment.','','YesNo'); diff --git a/installer/data/mysql/updatedatabase.pl b/installer/data/mysql/updatedatabase.pl index 6080ff2..1f6a235 100755 --- a/installer/data/mysql/updatedatabase.pl +++ b/installer/data/mysql/updatedatabase.pl @@ -5786,7 +5786,6 @@ $DBversion = "3.09.00.045"; if ( C4::Context->preference("Version") < TransformToNum($DBversion) ) { $dbh->do("ALTER TABLE borrower_attribute_types MODIFY category_code VARCHAR( 10 ) NULL DEFAULT NULL"); print "Upgrade to $DBversion done. (Bug 8002: Update patron attribute types table from varchar(1) to varchar(10) category_code)\nWarning to Koha System Administrators: If you use borrower attributes defined by borrower categories, you have to check your configuration. A bug may have removed your attribute links to borrower categories.\nPlease check, and fix it if necessary."; - SetVersion($DBversion); } $DBversion = "3.09.00.046"; @@ -6134,6 +6133,18 @@ if (C4::Context->preference("Version") < TransformToNum($DBversion)) { SetVersion ($DBversion); } +$DBversion = "3.11.00.XXX"; +if ( C4::Context->preference("Version") < TransformToNum($DBversion) ) { + $dbh->do(qq{ + INSERT IGNORE INTO systempreferences (variable,value,explanation,options,type) VALUES ('LogLevel','5','Set the level of logs. 1=Unusable, 2=Critical, 3=Error, 4=Warning, 5=Normal, 6=Info, 7=Debug','1|2|3|4|5|6|7','Choice'); + }); + $dbh->do(qq{ + INSERT IGNORE INTO systempreferences (variable,value,explanation,options,type) VALUES ('LogToHtmlComments','0','Embed the logs into the html as a comment.','','YesNo'); + }); + print "Upgrade to $DBversion done (Add system preferences LogLevel, LogToHtmlComments)\n"; + SetVersion($DBversion); +} + =head1 FUNCTIONS =head2 TableExists($table) diff --git a/koha-tmpl/intranet-tmpl/prog/en/includes/doc-head-open.inc b/koha-tmpl/intranet-tmpl/prog/en/includes/doc-head-open.inc index b8aa2ad..431f566 100644 --- a/koha-tmpl/intranet-tmpl/prog/en/includes/doc-head-open.inc +++ b/koha-tmpl/intranet-tmpl/prog/en/includes/doc-head-open.inc @@ -2,3 +2,8 @@ "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> [% IF ( bidi ) %][% ELSE %][% END %] +[%- IF LogToHtmlComments %] + +[% END %] diff --git a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/admin.pref b/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/admin.pref index 4e907e1..3d677f1 100644 --- a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/admin.pref +++ b/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/admin.pref @@ -112,3 +112,23 @@ Administration: Solr: Solr Zebra: Zebra - is the search engine used. + Logger: + - + - Set the level + - pref: LogLevel + choices: + 1: 1- Unusable + 2: 2- Critical + 3: 3- Error + 4: 4- Warning + 5: 5- Normal + 6: 6- Info + 7: 7- Debug + - for logs + - + - pref: LogToHtmlComments + default: 0 + choices: + yes: Embed + no: "Don't embed" + - log as a comment in the html. diff --git a/opac/opac-search.pl b/opac/opac-search.pl index 73d2c53..daee8fb 100755 --- a/opac/opac-search.pl +++ b/opac/opac-search.pl @@ -51,12 +51,15 @@ use C4::Tags qw(get_tags); use C4::Branch; # GetBranches use C4::SocialData; use C4::Ratings; +use Koha::Utils::Logger qw/$log/; use POSIX qw(ceil floor strftime); use URI::Escape; use Storable qw(thaw freeze); use Business::ISBN; +$log = Koha::Utils::Logger->new({level => C4::Context->preference("LogLevel")}); + my $DisplayMultiPlaceHold = C4::Context->preference("DisplayMultiPlaceHold"); # create a new CGI object # FIXME: no_undef_params needs to be tested @@ -492,6 +495,7 @@ elsif (C4::Context->preference('NoZebra')) { $pasarParams .= '&count=' . $results_per_page; $pasarParams .= '&simple_query=' . $simple_query; $pasarParams .= '&query_type=' . $query_type if ($query_type); + $log->info("OPAC: Search for $query"); eval { ($error, $results_hashref, $facets) = getRecords($query,$simple_query,\@sort_by,\@servers,$results_per_page,$offset,$expanded_facet,$branches,$itemtypes,$query_type,$scan,1); }; diff --git a/t/Logger.t b/t/Logger.t new file mode 100644 index 0000000..bff7733 --- /dev/null +++ b/t/Logger.t @@ -0,0 +1,95 @@ +#!/usr/bin/perl + +use utf8; +use Modern::Perl; +if ( not $ENV{KOHA_LOG} ) { + usage(); + exit; +} + +use Test::More; +require C4::Context; +import C4::Context; +plan tests => 15; + +my $logfile = $ENV{KOHA_LOG}; + +use_ok('Koha::Utils::Logger'); +isnt(C4::Context->preference("LogLevel"), undef, "Check LogLevel syspref"); +use Koha::Utils::Logger qw/$log/; +is($log, undef, "Check \$log is undef"); +$log = Koha::Utils::Logger->new({level => 3}); +isnt($log, undef, "Check \$log is not undef"); + + +my @lines = (); +$log->error( "an error string"); +$log->normal( "a normal string"); +@lines = get_contains( $logfile ); +is(grep (/an error string/, @lines), 1, "check error string with level 3"); +is(grep (/a normal string/, @lines), 0, "check normal string with level 3"); +truncate_file($logfile); +$log->level(5); +$log->error( "an error string"); +$log->normal( "a normal string"); +test_calledby( "test calledby" ); +my $struct = { + a => "aaaaa", + b => "bbbbb", + c => "ccccc" +}; +$log->warning($struct, 1); +@lines = get_contains( $logfile ); +is(grep (/an error string/, @lines), 1, "check error string with level 5"); +is(grep (/a normal string/, @lines), 1, "check normal string with level 5"); +is(grep (/test_calledby/, @lines), 1, "check calledby string with level 5"); +is(grep (/WARN/, @lines), 1, "check WARN string with dump"); +is(grep (/VAR1/, @lines), 1, "check VAR1 string with dump"); +is(grep (/aaaaa/, @lines), 1, "check values aaaaa string with dump"); +is(5, $log->level, "check log level return"); + + +$ENV{KOHA_LOG} = undef; +my $log_stderr_file = qq{/tmp/stderr.log}; +$log = undef; +$log = Koha::Utils::Logger->new({level => 3}); +open(STDERR, '>>', $log_stderr_file); +$log->error( "an error string"); +$log->normal( "a normal string"); +@lines = get_contains( $log_stderr_file ); +is(grep (/an error string/, @lines), 1, "check error string with level 3"); +is(grep (/a normal string/, @lines), 0, "check normal string with level 3"); + +system( qq{rm $logfile} ); +system( qq{rm $log_stderr_file} ); + +sub get_contains { + my $filepath = shift; + my @lines; + open my $fh, "<", $filepath or die "Can't open $filepath: $!"; + while(<$fh>) { + chomp; + push(@lines, $_); + } + close($fh); + return @lines; +} + +sub truncate_file { + my $filepath = shift; + open my $fh, ">", $filepath or die "Can't open $filepath: $!"; + truncate $fh, 0; + close $fh; +} + +sub test_calledby { + my $msg = shift; + $log->error($msg); +} + +sub usage { + warn "\n\n+=======================================================+\n"; + warn qq{| You must call this test with a KOHA_LOG env var like: |\n}; + warn qq{| KOHA_LOG="/tmp/t1.log" prove t/Logguer.t |\n}; + warn "+=======================================================+\n\n"; +} -- 1.7.2.5