From 8799d021b2287b160f82fb3da4c83dd916f7be43 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 the logger like: $logger= C4::Context->logger; $logger->debug("This is a debug message"); $logger->info("This is an information"); $logger->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. Includes (apparently from squashed patches): Bug 8190: Followup Logger: FIX perlcritic Bug 8190 - Followup - Add cached logger, output messages to template * Add C4::Context->logger * Embed logged messages to a comment in the template html, controlled by the system preference LogToHtmlComments\ * Add both new system preferences to sysprefs.sql Bug 8190 follow-up moving updatedatabase part at the right place Signed-off-by: Mason James Signed-off-by: Kyle M Hall Signed-off-by: Paul Poulain Signed-off-by: Marcel de Rooy Amended the patch for a updatedatabase problem. Edited the commit message. --- C4/Auth.pm | 2 + C4/Context.pm | 29 ++++ C4/Installer/PerlDependencies.pm | 5 + Koha/Utils/Logger.pm | 186 +++++++++++++++++++++ install_misc/debian.packages | 1 + installer/data/mysql/sysprefs.sql | 3 + installer/data/mysql/updatedatabase.pl | 12 ++ .../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(+) create mode 100644 Koha/Utils/Logger.pm create mode 100644 t/Logger.t diff --git a/C4/Auth.pm b/C4/Auth.pm index b808c66..901d549 100644 --- a/C4/Auth.pm +++ b/C4/Auth.pm @@ -403,6 +403,8 @@ sub get_template_and_user { EnableBorrowerFiles => C4::Context->preference('EnableBorrowerFiles'), UseKohaPlugins => C4::Context->preference('UseKohaPlugins'), UseCourseReserves => C4::Context->preference("UseCourseReserves"), + LogToHtmlComments => C4::Context->preference('LogToHtmlComments'), + Logger => C4::Context->logger(), ); } else { diff --git a/C4/Context.pm b/C4/Context.pm index c5f92ee..0fdfddf 100644 --- a/C4/Context.pm +++ b/C4/Context.pm @@ -19,6 +19,9 @@ package C4::Context; 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; @@ -1221,6 +1224,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"}; +} =head2 IsSuperLibrarian diff --git a/C4/Installer/PerlDependencies.pm b/C4/Installer/PerlDependencies.pm index 9e030a6..ef65bed 100644 --- a/C4/Installer/PerlDependencies.pm +++ b/C4/Installer/PerlDependencies.pm @@ -737,6 +737,11 @@ our $PERL_DEPS = { 'required' => '0', 'min_ver' => '5.61', }, + '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 9b8ad6d..d8fdcb5 100644 --- a/install_misc/debian.packages +++ b/install_misc/debian.packages @@ -72,6 +72,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 db9fd84..f65a612 100644 --- a/installer/data/mysql/sysprefs.sql +++ b/installer/data/mysql/sysprefs.sql @@ -193,6 +193,8 @@ INSERT INTO systempreferences ( `variable`, `value`, `options`, `explanation`, ` ('LocalHoldsPriority', '0', NULL, 'Enables the LocalHoldsPriority feature', 'YesNo'), ('LocalHoldsPriorityItemControl', 'holdingbranch', 'holdingbranch|homebranch', 'decides if the feature operates using the item''s home or holding library.', 'Choice'), ('LocalHoldsPriorityPatronControl', 'PickupLibrary', 'HomeLibrary|PickupLibrary', 'decides if the feature operates using the library set as the patron''s home library, or the library set as the pickup library for the given hold.', 'Choice'), +('LogLevel', '5', '1|2|3|4|5|6|7', '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'), +('LogToHtmlComments', '0', NULL, 'Embed the logs into the html as a comment.', 'YesNo'), ('ManInvInNoissuesCharge','1',NULL,'MANUAL_INV charges block checkouts (added to noissuescharge).','YesNo'), ('MARCAuthorityControlField008','|| aca||aabn | a|a d',NULL,'Define the contents of MARC21 authority control field 008 position 06-39','Textarea'), ('MarcFieldsToOrder','',NULL,'Set the mapping values for a new order line created from a MARC record in a staged file. In a YAML format.','textarea'), @@ -474,3 +476,4 @@ INSERT INTO systempreferences ( `variable`, `value`, `options`, `explanation`, ` ('z3950AuthorAuthFields','701,702,700',NULL,'Define the MARC biblio fields for Personal Name Authorities to fill biblio.author','free'), ('z3950NormalizeAuthor','0','','If ON, Personal Name Authorities will replace authors in biblio.author','YesNo') ; + diff --git a/installer/data/mysql/updatedatabase.pl b/installer/data/mysql/updatedatabase.pl index c380800..3e38bd6 100755 --- a/installer/data/mysql/updatedatabase.pl +++ b/installer/data/mysql/updatedatabase.pl @@ -9628,6 +9628,18 @@ if ( CheckVersion($DBversion) ) { SetVersion($DBversion); } +$DBversion = "3.19.00.XXX"; +if ( CheckVersion($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 (Bug 8190 - 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 23449a5..9c1bb1c 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 @@ [% 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 f796361..7c94d14 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 @@ -157,3 +157,23 @@ Administration: subscription: "subscription" - will be shown on the Hea Koha community website. - Note that this value has no effect if the UsageStats system preference is set to "Don't share" + 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 692d70b..7eb1f7e 100755 --- a/opac/opac-search.pl +++ b/opac/opac-search.pl @@ -42,12 +42,15 @@ use C4::Branch; # GetBranches use C4::SocialData; use C4::Ratings; use C4::External::OverDrive; +use Koha::Utils::Logger qw/$log/; use POSIX qw(ceil floor strftime); use URI::Escape; use JSON qw/decode_json encode_json/; 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 @@ -548,6 +551,7 @@ if ($tag) { $pasarParams .= '&count=' . uri_escape($results_per_page); $pasarParams .= '&simple_query=' . uri_escape($simple_query); $pasarParams .= '&query_type=' . uri_escape($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"; +} -- 2.1.0