Bugzilla – Attachment 12743 Details for
Bug 8190
Add a logging module to Koha
Home
|
New
|
Browse
|
Search
|
[?]
|
Reports
|
Help
|
New Account
|
Log In
[x]
|
Forgot Password
Login:
[x]
[patch]
[SIGNED-OFF] Bug 8190: Koha::Utils::Logger, Logging module
Bug-8190-KohaUtilsLogger-Logging-module.patch (text/plain), 13.30 KB, created by
Kyle M Hall (khall)
on 2012-10-09 13:11:22 UTC
(
hide
)
Description:
[SIGNED-OFF] Bug 8190: Koha::Utils::Logger, Logging module
Filename:
MIME Type:
Creator:
Kyle M Hall (khall)
Created:
2012-10-09 13:11:22 UTC
Size:
13.30 KB
patch
obsolete
>From 27ba80de7df733197c25e8e8f39707f27fa7b70c Mon Sep 17 00:00:00 2001 >From: Jonathan Druart <jonathan.druart@biblibre.com> >Date: Tue, 5 Jun 2012 15:51:06 +0200 >Subject: [PATCH] Bug 8190: Koha::Utils::Logger, Logging module >Content-Type: text/plain; charset="utf-8" > >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 <mtj@kohaaloha.com> >Signed-off-by: Kyle M Hall <kyle@bywatersolutions.com> >--- > C4/Installer/PerlDependencies.pm | 5 + > Koha/Utils/Logger.pm | 176 ++++++++++++++++++++ > install_misc/debian.packages | 1 + > installer/data/mysql/updatedatabase.pl | 8 + > .../prog/en/modules/admin/preferences/admin.pref | 13 ++ > opac/opac-search.pl | 4 + > t/Logger.t | 95 +++++++++++ > 7 files changed, 302 insertions(+), 0 deletions(-) > create mode 100644 Koha/Utils/Logger.pm > create mode 100644 t/Logger.t > >diff --git a/C4/Installer/PerlDependencies.pm b/C4/Installer/PerlDependencies.pm >index be80a9a..e061fcd 100644 >--- a/C4/Installer/PerlDependencies.pm >+++ b/C4/Installer/PerlDependencies.pm >@@ -620,6 +620,11 @@ our $PERL_DEPS = { > 'required' => '0', > 'min_ver' => '2.13', > }, >+ '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..10f74a7 >--- /dev/null >+++ b/Koha/Utils/Logger.pm >@@ -0,0 +1,176 @@ >+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; >+ 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 = "[<date>] $LEVEL_STR->{$log_level}: <message>"; >+ $template .= " (caller: $cb)" if $cb; >+ $template .= "\n"; >+ $self->{LOGGER}->template($template); >+ $msg = "\n" . Dumper $msg if $dump; >+ $self->{LOGGER}->write($msg, $log_level); >+} >+ >+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 $subr (@subr) { >+ $str .= $subr; >+ $str .= " > "; >+ } >+ $str =~ s/ > $/: /; >+ return $str; >+} # of called_by >+ >+1; >diff --git a/install_misc/debian.packages b/install_misc/debian.packages >index 153bcb7..4bbfaed 100644 >--- a/install_misc/debian.packages >+++ b/install_misc/debian.packages >@@ -56,6 +56,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/updatedatabase.pl b/installer/data/mysql/updatedatabase.pl >index e67bf3e..8de6d5f 100755 >--- a/installer/data/mysql/updatedatabase.pl >+++ b/installer/data/mysql/updatedatabase.pl >@@ -5784,6 +5784,14 @@ $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."; >+} >+ >+$DBversion = "3.09.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'); >+ }); >+ print "Upgrade to $DBversion done (Add system preference LogLevel)\n"; > SetVersion($DBversion); > } > >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..3b259e3 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,16 @@ 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 >diff --git a/opac/opac-search.pl b/opac/opac-search.pl >index 7677d86..4864936 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 >@@ -493,6 +496,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..11addf0 >--- /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 FILE, "<", $filepath or die "Can't open $filepath: $!"; >+ while(<FILE>) { >+ chomp; >+ push(@lines, $_); >+ } >+ close(FILE); >+ return @lines; >+} >+ >+sub truncate_file { >+ my $filepath = shift; >+ open FILE, ">", $filepath or die "Can't open $filepath: $!"; >+ truncate FILE, 0; >+ close FILE; >+} >+ >+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
You cannot view the attachment while viewing its details because your browser does not support IFRAMEs.
View the attachment on a separate page
.
View Attachment As Diff
View Attachment As Raw
Actions:
View
|
Diff
|
Splinter Review
Attachments on
bug 8190
:
9921
|
10996
|
12257
|
12264
|
12265
|
12270
|
12282
|
12283
|
12284
|
12287
|
12743
|
12744
|
12745
|
12746
|
13739
|
13740
|
13762
|
13763
|
13925
|
13926
|
14294
|
14296
|
14318
|
14319
|
14320
|
14321
|
14324
|
14388
|
14703
|
14704
|
14705
|
16426
|
16427
|
16428
|
16429
|
16430
|
18799
|
18800
|
18801
|
18802
|
18803
|
18819
|
18820
|
18870
|
18871
|
18872
|
18873
|
18874
|
18875
|
18876
|
18877
|
18880
|
18881
|
18882
|
18883
|
18884
|
18886
|
18887
|
18888
|
18890
|
34837
|
34838
|
34839
|
34840
|
34841
|
34842
|
34843
|
34844
|
34845