From 5c81ce615ba9c2f10c58061e9ecb1131dca2d345 Mon Sep 17 00:00:00 2001 From: Olli-Antti Kivilahti Date: Wed, 20 Apr 2016 19:57:57 +0300 Subject: [PATCH] Bug 16312 - Koha::Logger overload configuration for command line scripts verbosity levels To be able to set the -v|--verbose flags from the command line and still use Koha::Logger, we must be able to overload/extend default appenders and log levels on a easy case-by-case basis directly from the Perl-code. To deploy verbose mode in a commandline script, add the following code to your cronjob/script: use C4::Context; use Koha::Logger; C4::Context->setCommandlineEnvironment(); Koha::Logger->setConsoleVerbosity( 1 || -3 || 'WARN' || ... ); The module using the Koha::Logger must lazyLoad the module/package-level logger using Koha::Logger->new(), so the overloads can be deployed. See attached tests and perldoc for more info. --- Koha/Logger.pm | 94 +++++++++++++++++++++++++++++++++++++++- t/Koha/Logger.pm | 4 ++ t/Koha/Logger.t | 127 ++++++++++++++++++++++++++++++++++++++++++++++++++++++- 3 files changed, 221 insertions(+), 4 deletions(-) diff --git a/Koha/Logger.pm b/Koha/Logger.pm index 9c28c95..a4c91a9 100644 --- a/Koha/Logger.pm +++ b/Koha/Logger.pm @@ -2,6 +2,7 @@ package Koha::Logger; # Copyright 2015 ByWater Solutions # kyle@bywatersolutions.com +# Copyright 2016 Koha-Suomi Oy # # This file is part of Koha. # @@ -34,6 +35,7 @@ use Modern::Perl; use Log::Log4perl; use Carp; +use Scalar::Util qw(blessed); use C4::Context; @@ -82,6 +84,9 @@ sub get { $self->{logs} = $init if ref $init; } bless $self, $class; + + $self->_checkLoggerOverloads(); + return $self; } @@ -113,8 +118,7 @@ sub AUTOLOAD { warn "$method: $line" if $line; } elsif ( $self->{logger}->can($method) ) { #use log4perl - $self->{logger}->$method($line); - return 1; + return $self->{logger}->$method($line); } else { # we should not really get here warn "ERROR: Unsupported method $method"; @@ -199,10 +203,96 @@ sub _recheck_logfile { # recheck saved logfile when logging message return -w $log; } +=head2 setConsoleVerbosity + + Koha::Logger->setConsoleVerbosity($verbosity); + +Sets all Koha::Loggers to use also the console for logging and adjusts their verbosity by the given verbosity. + +=USAGE + +Do deploy verbose mode in a commandline script, add the following code: + + use C4::Context; + use Koha::Logger; + C4::Context->setCommandlineEnvironment(); + Koha::Logger->setConsoleVerbosity( 1 || -3 || 'WARN' || ... ); + +=PARAMS + +@param {String or Signed Integer} $verbosity, + if $verbosity is 0, no adjustment is made, + If $verbosity is > 1, log level is decremented by that many steps towards TRACE + If $verbosity is < 0, log level is incremented by that many steps towards FATAL + If $verbosity is one of log levels, log level is set to that level. + If $verbosity is undef, clear all overrides. + +=cut + +sub setConsoleVerbosity { + if ($_[0] eq __PACKAGE__ || blessed($_[0]) && $_[0]->isa('Koha::Logger') ) { + shift(@_); #Compensate for erratic calling styles. + } + my ($verbosity) = @_; + + if (defined($verbosity)) { #Tell all Koha::Loggers to use a console logger as well + unless ($verbosity =~ /^-?\d+$/ || + $verbosity =~ /^(?:FATAL|ERROR|WARN|INFO|DEBUG|TRACE)$/) { + my @cc = caller(0); + die $cc[3]."($verbosity):> \$verbosity must be a positive or negative digit, or a valid Log::Log4perl log level, eg. FATAL, ERROR, WARN, ..."; + } + $ENV{LOG4PERL_TO_CONSOLE} = 1; + + $ENV{LOG4PERL_VERBOSITY_CHANGE} = $verbosity if defined($verbosity); + } + else { + delete $ENV{LOG4PERL_TO_CONSOLE}; + delete $ENV{LOG4PERL_VERBOSITY_CHANGE}; + } +} + +=head2 _checkLoggerOverloads + +Checks if there are Environment variables that should overload configured behaviour + +=cut + +# Define a stdout appender. I wonder how can I load a PatternedLayout from log4perl.conf here? +my $commandlineScreen = Log::Log4perl::Appender->new( + "Log::Log4perl::Appender::Screen", + name => "commandlineScreen", + stderr => 0); +my $commandlineLayout = Log::Log4perl::Layout::PatternLayout->new( #I want this to be defined in log4perl.conf instead :( + "%d (%F:%L)> %m %n"); +$commandlineScreen->layout($commandlineLayout); + +sub _checkLoggerOverloads { + my ($self) = @_; + return unless blessed($self->{logger}) && $self->{logger}->isa('Log::Log4perl::Logger'); + + if ($ENV{LOG4PERL_TO_CONSOLE}) { + $self->{logger}->add_appender($commandlineScreen); + } + if ($ENV{LOG4PERL_VERBOSITY_CHANGE}) { + if ($ENV{LOG4PERL_VERBOSITY_CHANGE} =~ /^-?(\d)$/) { + if ($ENV{LOG4PERL_VERBOSITY_CHANGE} > 0) { + $self->{logger}->dec_level( $1 ); + } + elsif ($ENV{LOG4PERL_VERBOSITY_CHANGE} < 0) { + $self->{logger}->inc_level( $1 ); + } + } + else { + $self->{logger}->level( $ENV{LOG4PERL_VERBOSITY_CHANGE} ); + } + } +} + =head1 AUTHOR Kyle M Hall, Ekyle@bywatersolutions.comE Marcel de Rooy, Rijksmuseum +Olli-Antti Kivilahti, Eolli-antti.kivilahti@jns.fiE =cut diff --git a/t/Koha/Logger.pm b/t/Koha/Logger.pm index 9b22180..a8ab060 100644 --- a/t/Koha/Logger.pm +++ b/t/Koha/Logger.pm @@ -80,4 +80,8 @@ sub clearLog { close($FH); } +sub getLogfile { + return $logfile; +} + 1; #Satisfy insanity diff --git a/t/Koha/Logger.t b/t/Koha/Logger.t index 7e97816..d13d10e 100644 --- a/t/Koha/Logger.t +++ b/t/Koha/Logger.t @@ -19,14 +19,17 @@ use Modern::Perl; use Test::More; use Log::Log4perl; +use Scalar::Util qw(blessed); +use Try::Tiny; + use C4::Context; -C4::Context->interface('commandline'); #Set the context already prior to loading Koha::Logger (this actually doesn't fix the logger interface definition issue. Just doing it like this to show this doesn't work) +C4::Context->setCommandlineEnvironment(); #Set the context already prior to loading Koha::Logger (this actually doesn't fix the logger interface definition issue. Just doing it like this to show this doesn't work) is(C4::Context->interface(), 'commandline', "Current Koha interface is 'commandline'"); #Show in test output what we are expecting to make test plan more understandable #Initialize the Log4perl to write to /tmp/log4perl_test.log so we can clean it later Log::Log4perl::init( t::Koha::Logger::getLog4perlConfig() ); -use Koha::Logger; +require Koha::Logger; use t::Koha::Logger; @@ -56,5 +59,125 @@ t::Koha::Logger::clearLog(); #### END OF Test for Bug 16304 - Koha::Logger, lazy load loggers so environment has time to get set #### ######################################################################################################### +############################################################################################### +#### KD976 - Koha::Logger overload configuration for command line scripts verbosity levels #### +subtest "Overload Logger configurations", \&overloadLoggerConfigurations; +sub overloadLoggerConfigurations { + my ($logger, $log, $LOGFILEOUT, $stdoutLogHandle, $stdoutLogPtr, @stdoutLog); + $stdoutLogPtr = \$stdoutLogHandle; + + #Test increasing log verbosity + ($LOGFILEOUT, $stdoutLogPtr) = _reopenStdoutScalarHandle($LOGFILEOUT, $stdoutLogPtr); + Koha::Logger->setConsoleVerbosity(1); + $logger = Koha::Logger->get({category => "test-is-fun-1"}); + _loggerBlarbAllLevels($logger); + $log = t::Koha::Logger::slurpLog('wantArray'); + @stdoutLog = split("\n", $stdoutLogHandle); + ok($log->[0] =~ /info/, 'Increment by 1. file - info ok'); + ok($stdoutLog[0] =~ /info/, 'Increment by 1. stdout - info ok'); + ok($log->[1] =~ /warn/, 'Increment by 1. file - warn ok'); + ok($stdoutLog[1] =~ /warn/, 'Increment by 1. stdout - warn ok'); + ok($log->[2] =~ /error/, 'Increment by 1. file - error ok'); + ok($stdoutLog[2] =~ /error/, 'Increment by 1. stdout - error ok'); + ok($log->[3] =~ /fatal/, 'Increment by 1. file - fatal ok'); + ok($stdoutLog[3] =~ /fatal/, 'Increment by 1. stdout - fatal ok'); + t::Koha::Logger::clearLog(); + + #Test decreasing log verbosity + ($LOGFILEOUT, $stdoutLogPtr) = _reopenStdoutScalarHandle($LOGFILEOUT, $stdoutLogPtr); + Koha::Logger->setConsoleVerbosity(-1); + $logger = Koha::Logger->get({category => "test-is-fun-2"}); + _loggerBlarbAllLevels($logger); + $log = t::Koha::Logger::slurpLog('wantArray'); + @stdoutLog = split("\n", $stdoutLogHandle); + ok($log->[0] =~ /error/, 'Decrement by 1. file - error ok'); + ok($stdoutLog[0] =~ /error/, 'Decrement by 1. stdout - error ok'); + ok($log->[1] =~ /fatal/, 'Decrement by 1. file - fatal ok'); + ok($stdoutLog[1] =~ /fatal/, 'Decrement by 1. stdout - fatal ok'); + t::Koha::Logger::clearLog(); + + #Test increasing log verbosity multiple levels + ($LOGFILEOUT, $stdoutLogPtr) = _reopenStdoutScalarHandle($LOGFILEOUT, $stdoutLogPtr); + Koha::Logger->setConsoleVerbosity(2); + $logger = Koha::Logger->get({category => "test-is-fun-3"}); + _loggerBlarbAllLevels($logger); + $log = t::Koha::Logger::slurpLog('wantArray'); + @stdoutLog = split("\n", $stdoutLogHandle); + ok($log->[0] =~ /debug/, 'Increment by 1. file - debug ok'); + ok($stdoutLog[0] =~ /debug/, 'Increment by 1. stdout - debug ok'); + ok($log->[1] =~ /info/, 'Increment by 1. file - info ok'); + ok($stdoutLog[1] =~ /info/, 'Increment by 1. stdout - info ok'); + ok($log->[2] =~ /warn/, 'Increment by 1. file - warn ok'); + ok($stdoutLog[2] =~ /warn/, 'Increment by 1. stdout - warn ok'); + ok($log->[3] =~ /error/, 'Increment by 1. file - error ok'); + ok($stdoutLog[3] =~ /error/, 'Increment by 1. stdout - error ok'); + ok($log->[4] =~ /fatal/, 'Increment by 1. file - fatal ok'); + ok($stdoutLog[4] =~ /fatal/, 'Increment by 1. stdout - fatal ok'); + t::Koha::Logger::clearLog(); + + #Test decreasing log verbosity beyond FATAL, this results to no output + ($LOGFILEOUT, $stdoutLogPtr) = _reopenStdoutScalarHandle($LOGFILEOUT, $stdoutLogPtr); + Koha::Logger->setConsoleVerbosity(-3); + $logger = Koha::Logger->get({category => "test-is-fun-4"}); + _loggerBlarbAllLevels($logger); + $log = t::Koha::Logger::slurpLog('wantArray'); + @stdoutLog = split("\n", $stdoutLogHandle); + is(scalar(@$log), 0, 'Decrement overboard. no logging'); + t::Koha::Logger::clearLog(); + + #Test static log level + ($LOGFILEOUT, $stdoutLogPtr) = _reopenStdoutScalarHandle($LOGFILEOUT, $stdoutLogPtr); + Koha::Logger->setConsoleVerbosity('FATAL'); + $logger = Koha::Logger->get({category => "test-is-fun-5"}); + _loggerBlarbAllLevels($logger); + $log = t::Koha::Logger::slurpLog('wantArray'); + @stdoutLog = split("\n", $stdoutLogHandle); + ok($log->[0] =~ /fatal/, 'Static log level. file - fatal ok'); + ok($stdoutLog[0] =~ /fatal/, 'Static log level. stdout - fatal ok'); + t::Koha::Logger::clearLog(); + + #Test bad log level, then continue using the default config unhindered + Koha::Logger->setConsoleVerbosity(); #Clear overrides with empty params + ($LOGFILEOUT, $stdoutLogPtr) = _reopenStdoutScalarHandle($LOGFILEOUT, $stdoutLogPtr); + try { + Koha::Logger->setConsoleVerbosity('WARNNNG'); + die "We should have died"; + } catch { + ok($_ =~ /verbosity must be a positive or negative digit/, "Bad \$verbosiness, but got instructions on how to properly give \$verbosiness"); + }; + $logger = Koha::Logger->get({category => "test-is-fun-6"}); + _loggerBlarbAllLevels($logger); + $log = t::Koha::Logger::slurpLog('wantArray'); + @stdoutLog = split("\n", $stdoutLogHandle); + is(scalar(@stdoutLog), 0, 'Bad config, defaulting. Stdout not printed to in default mode.'); + ok($log->[0] =~ /warn/, 'Bad config, defaulting. file - warn ok'); + ok($log->[1] =~ /error/, 'Bad config, defaulting. file - error ok'); + ok($log->[2] =~ /fatal/, 'Bad config, defaulting. file - fatal ok'); + t::Koha::Logger::clearLog(); + + close($LOGFILEOUT); +} + +#### END OF Test for KD976 - Koha::Logger overload configuration for command line scripts verbosity levels #### +############################################################################################################### + +sub _loggerBlarbAllLevels { + my ($logger) = @_; + $logger->trace('trace'); + $logger->debug('debug'); + $logger->info('info'); + $logger->warn('warn'); + $logger->error('error'); + $logger->fatal('fatal'); +} +sub _reopenStdoutScalarHandle { + my ($LOGFILEOUT, $pointerToScalar) = @_; + $$pointerToScalar = ''; + close($LOGFILEOUT) if $LOGFILEOUT; + open($LOGFILEOUT, '>', $pointerToScalar) or die $!; + $LOGFILEOUT->autoflush ( 1 ); + select $LOGFILEOUT; #Use this as the default print target, so Console appender is redirected to this logfile + return ($LOGFILEOUT, $pointerToScalar); +} done_testing(); \ No newline at end of file -- 1.9.1