View | Details | Raw Unified | Return to bug 16312
Collapse All | Expand All

(-)a/Koha/Logger.pm (-2 / +92 lines)
Lines 2-7 package Koha::Logger; Link Here
2
2
3
# Copyright 2015 ByWater Solutions
3
# Copyright 2015 ByWater Solutions
4
# kyle@bywatersolutions.com
4
# kyle@bywatersolutions.com
5
# Copyright 2016 Koha-Suomi Oy
5
#
6
#
6
# This file is part of Koha.
7
# This file is part of Koha.
7
#
8
#
Lines 34-39 use Modern::Perl; Link Here
34
35
35
use Log::Log4perl;
36
use Log::Log4perl;
36
use Carp;
37
use Carp;
38
use Scalar::Util qw(blessed);
37
39
38
use C4::Context;
40
use C4::Context;
39
41
Lines 82-87 sub get { Link Here
82
        $self->{logs}   = $init if ref $init;
84
        $self->{logs}   = $init if ref $init;
83
    }
85
    }
84
    bless $self, $class;
86
    bless $self, $class;
87
88
    $self->_checkLoggerOverloads();
89
85
    return $self;
90
    return $self;
86
}
91
}
87
92
Lines 113-120 sub AUTOLOAD { Link Here
113
        warn "$method: $line" if $line;
118
        warn "$method: $line" if $line;
114
    }
119
    }
115
    elsif ( $self->{logger}->can($method) ) {    #use log4perl
120
    elsif ( $self->{logger}->can($method) ) {    #use log4perl
116
        $self->{logger}->$method($line);
121
        return $self->{logger}->$method($line);
117
        return 1;
118
    }
122
    }
119
    else {                                       # we should not really get here
123
    else {                                       # we should not really get here
120
        warn "ERROR: Unsupported method $method";
124
        warn "ERROR: Unsupported method $method";
Lines 199-208 sub _recheck_logfile { # recheck saved logfile when logging message Link Here
199
    return -w $log;
203
    return -w $log;
200
}
204
}
201
205
206
=head2 setConsoleVerbosity
207
208
    Koha::Logger->setConsoleVerbosity($verbosity);
209
210
Sets all Koha::Loggers to use also the console for logging and adjusts their verbosity by the given verbosity.
211
212
=USAGE
213
214
Do deploy verbose mode in a commandline script, add the following code:
215
216
    use C4::Context;
217
    use Koha::Logger;
218
    C4::Context->setCommandlineEnvironment();
219
    Koha::Logger->setConsoleVerbosity( 1 || -3 || 'WARN' || ... );
220
221
=PARAMS
222
223
@param {String or Signed Integer} $verbosity,
224
                if $verbosity is 0, no adjustment is made,
225
                If $verbosity is > 1, log level is decremented by that many steps towards TRACE
226
                If $verbosity is < 0, log level is incremented by that many steps towards FATAL
227
                If $verbosity is one of log levels, log level is set to that level.
228
                If $verbosity is undef, clear all overrides.
229
230
=cut
231
232
sub setConsoleVerbosity {
233
    if ($_[0] eq __PACKAGE__ || blessed($_[0]) && $_[0]->isa('Koha::Logger') ) {
234
        shift(@_); #Compensate for erratic calling styles.
235
    }
236
    my ($verbosity) = @_;
237
238
    if (defined($verbosity)) { #Tell all Koha::Loggers to use a console logger as well
239
        unless ($verbosity =~ /^-?\d+$/ ||
240
                $verbosity =~ /^(?:FATAL|ERROR|WARN|INFO|DEBUG|TRACE)$/) {
241
            my @cc = caller(0);
242
            die $cc[3]."($verbosity):> \$verbosity must be a positive or negative digit, or a valid Log::Log4perl log level, eg. FATAL, ERROR, WARN, ...";
243
        }
244
        $ENV{LOG4PERL_TO_CONSOLE} = 1;
245
246
        $ENV{LOG4PERL_VERBOSITY_CHANGE} = $verbosity if defined($verbosity);
247
    }
248
    else {
249
        delete $ENV{LOG4PERL_TO_CONSOLE};
250
        delete $ENV{LOG4PERL_VERBOSITY_CHANGE};
251
    }
252
}
253
254
=head2 _checkLoggerOverloads
255
256
Checks if there are Environment variables that should overload configured behaviour
257
258
=cut
259
260
# Define a stdout appender. I wonder how can I load a PatternedLayout from log4perl.conf here?
261
my $commandlineScreen =  Log::Log4perl::Appender->new(
262
                             "Log::Log4perl::Appender::Screen",
263
                             name      => "commandlineScreen",
264
                             stderr    => 0);
265
my $commandlineLayout = Log::Log4perl::Layout::PatternLayout->new( #I want this to be defined in log4perl.conf instead :(
266
                   "%d (%F:%L)> %m %n");
267
$commandlineScreen->layout($commandlineLayout);
268
269
sub _checkLoggerOverloads {
270
    my ($self) = @_;
271
    return unless blessed($self->{logger}) && $self->{logger}->isa('Log::Log4perl::Logger');
272
273
    if ($ENV{LOG4PERL_TO_CONSOLE}) {
274
        $self->{logger}->add_appender($commandlineScreen);
275
    }
276
    if ($ENV{LOG4PERL_VERBOSITY_CHANGE}) {
277
        if ($ENV{LOG4PERL_VERBOSITY_CHANGE} =~ /^-?(\d)$/) {
278
            if ($ENV{LOG4PERL_VERBOSITY_CHANGE} > 0) {
279
                $self->{logger}->dec_level( $1 );
280
            }
281
            elsif ($ENV{LOG4PERL_VERBOSITY_CHANGE} < 0) {
282
                $self->{logger}->inc_level( $1 );
283
            }
284
        }
285
        else {
286
            $self->{logger}->level( $ENV{LOG4PERL_VERBOSITY_CHANGE} );
287
        }
288
    }
289
}
290
202
=head1 AUTHOR
291
=head1 AUTHOR
203
292
204
Kyle M Hall, E<lt>kyle@bywatersolutions.comE<gt>
293
Kyle M Hall, E<lt>kyle@bywatersolutions.comE<gt>
205
Marcel de Rooy, Rijksmuseum
294
Marcel de Rooy, Rijksmuseum
295
Olli-Antti Kivilahti, E<lt>olli-antti.kivilahti@jns.fiE<gt>
206
296
207
=cut
297
=cut
208
298
(-)a/t/Koha/Logger.pm (+4 lines)
Lines 80-83 sub clearLog { Link Here
80
    close($FH);
80
    close($FH);
81
}
81
}
82
82
83
sub getLogfile {
84
    return $logfile;
85
}
86
83
1; #Satisfy insanity
87
1; #Satisfy insanity
(-)a/t/Koha/Logger.t (-3 / +125 lines)
Lines 19-32 use Modern::Perl; Link Here
19
use Test::More;
19
use Test::More;
20
20
21
use Log::Log4perl;
21
use Log::Log4perl;
22
use Scalar::Util qw(blessed);
23
use Try::Tiny;
24
22
use C4::Context;
25
use C4::Context;
23
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)
26
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)
24
is(C4::Context->interface(), 'commandline', "Current Koha interface is 'commandline'"); #Show in test output what we are expecting to make test plan more understandable
27
is(C4::Context->interface(), 'commandline', "Current Koha interface is 'commandline'"); #Show in test output what we are expecting to make test plan more understandable
25
28
26
#Initialize the Log4perl to write to /tmp/log4perl_test.log so we can clean it later
29
#Initialize the Log4perl to write to /tmp/log4perl_test.log so we can clean it later
27
Log::Log4perl::init( t::Koha::Logger::getLog4perlConfig() );
30
Log::Log4perl::init( t::Koha::Logger::getLog4perlConfig() );
28
31
29
use Koha::Logger;
32
require Koha::Logger;
30
use t::Koha::Logger;
33
use t::Koha::Logger;
31
34
32
35
Lines 56-60 t::Koha::Logger::clearLog(); Link Here
56
#### END OF Test for Bug 16304 - Koha::Logger, lazy load loggers so environment has time to get set  ####
59
#### END OF Test for Bug 16304 - Koha::Logger, lazy load loggers so environment has time to get set  ####
57
#########################################################################################################
60
#########################################################################################################
58
61
62
###############################################################################################
63
#### KD976 - Koha::Logger overload configuration for command line scripts verbosity levels ####
64
subtest "Overload Logger configurations", \&overloadLoggerConfigurations;
65
sub overloadLoggerConfigurations {
66
    my ($logger, $log, $LOGFILEOUT, $stdoutLogHandle, $stdoutLogPtr, @stdoutLog);
67
    $stdoutLogPtr = \$stdoutLogHandle;
68
69
    #Test increasing log verbosity
70
    ($LOGFILEOUT, $stdoutLogPtr) = _reopenStdoutScalarHandle($LOGFILEOUT, $stdoutLogPtr);
71
    Koha::Logger->setConsoleVerbosity(1);
72
    $logger = Koha::Logger->get({category => "test-is-fun-1"});
73
    _loggerBlarbAllLevels($logger);
74
    $log = t::Koha::Logger::slurpLog('wantArray');
75
    @stdoutLog = split("\n", $stdoutLogHandle);
76
    ok($log->[0]     =~ /info/,  'Increment by 1. file   - info ok');
77
    ok($stdoutLog[0] =~ /info/,  'Increment by 1. stdout - info ok');
78
    ok($log->[1]     =~ /warn/,  'Increment by 1. file   - warn ok');
79
    ok($stdoutLog[1] =~ /warn/,  'Increment by 1. stdout - warn ok');
80
    ok($log->[2]     =~ /error/, 'Increment by 1. file   - error ok');
81
    ok($stdoutLog[2] =~ /error/, 'Increment by 1. stdout - error ok');
82
    ok($log->[3]     =~ /fatal/, 'Increment by 1. file   - fatal ok');
83
    ok($stdoutLog[3] =~ /fatal/, 'Increment by 1. stdout - fatal ok');
84
    t::Koha::Logger::clearLog();
85
86
    #Test decreasing log verbosity
87
    ($LOGFILEOUT, $stdoutLogPtr) = _reopenStdoutScalarHandle($LOGFILEOUT, $stdoutLogPtr);
88
    Koha::Logger->setConsoleVerbosity(-1);
89
    $logger = Koha::Logger->get({category => "test-is-fun-2"});
90
    _loggerBlarbAllLevels($logger);
91
    $log = t::Koha::Logger::slurpLog('wantArray');
92
    @stdoutLog = split("\n", $stdoutLogHandle);
93
    ok($log->[0]     =~ /error/, 'Decrement by 1. file   - error ok');
94
    ok($stdoutLog[0] =~ /error/, 'Decrement by 1. stdout - error ok');
95
    ok($log->[1]     =~ /fatal/, 'Decrement by 1. file   - fatal ok');
96
    ok($stdoutLog[1] =~ /fatal/, 'Decrement by 1. stdout - fatal ok');
97
    t::Koha::Logger::clearLog();
98
99
    #Test increasing log verbosity multiple levels
100
    ($LOGFILEOUT, $stdoutLogPtr) = _reopenStdoutScalarHandle($LOGFILEOUT, $stdoutLogPtr);
101
    Koha::Logger->setConsoleVerbosity(2);
102
    $logger = Koha::Logger->get({category => "test-is-fun-3"});
103
    _loggerBlarbAllLevels($logger);
104
    $log = t::Koha::Logger::slurpLog('wantArray');
105
    @stdoutLog = split("\n", $stdoutLogHandle);
106
    ok($log->[0]     =~ /debug/, 'Increment by 1. file   - debug ok');
107
    ok($stdoutLog[0] =~ /debug/, 'Increment by 1. stdout - debug ok');
108
    ok($log->[1]     =~ /info/,  'Increment by 1. file   - info ok');
109
    ok($stdoutLog[1] =~ /info/,  'Increment by 1. stdout - info ok');
110
    ok($log->[2]     =~ /warn/,  'Increment by 1. file   - warn ok');
111
    ok($stdoutLog[2] =~ /warn/,  'Increment by 1. stdout - warn ok');
112
    ok($log->[3]     =~ /error/, 'Increment by 1. file   - error ok');
113
    ok($stdoutLog[3] =~ /error/, 'Increment by 1. stdout - error ok');
114
    ok($log->[4]     =~ /fatal/, 'Increment by 1. file   - fatal ok');
115
    ok($stdoutLog[4] =~ /fatal/, 'Increment by 1. stdout - fatal ok');
116
    t::Koha::Logger::clearLog();
117
118
    #Test decreasing log verbosity beyond FATAL, this results to no output
119
    ($LOGFILEOUT, $stdoutLogPtr) = _reopenStdoutScalarHandle($LOGFILEOUT, $stdoutLogPtr);
120
    Koha::Logger->setConsoleVerbosity(-3);
121
    $logger = Koha::Logger->get({category => "test-is-fun-4"});
122
    _loggerBlarbAllLevels($logger);
123
    $log = t::Koha::Logger::slurpLog('wantArray');
124
    @stdoutLog = split("\n", $stdoutLogHandle);
125
    is(scalar(@$log), 0,         'Decrement overboard. no logging');
126
    t::Koha::Logger::clearLog();
127
128
    #Test static log level
129
    ($LOGFILEOUT, $stdoutLogPtr) = _reopenStdoutScalarHandle($LOGFILEOUT, $stdoutLogPtr);
130
    Koha::Logger->setConsoleVerbosity('FATAL');
131
    $logger = Koha::Logger->get({category => "test-is-fun-5"});
132
    _loggerBlarbAllLevels($logger);
133
    $log = t::Koha::Logger::slurpLog('wantArray');
134
    @stdoutLog = split("\n", $stdoutLogHandle);
135
    ok($log->[0]     =~ /fatal/, 'Static log level. file   - fatal ok');
136
    ok($stdoutLog[0] =~ /fatal/, 'Static log level. stdout - fatal ok');
137
    t::Koha::Logger::clearLog();
138
139
    #Test bad log level, then continue using the default config unhindered
140
    Koha::Logger->setConsoleVerbosity(); #Clear overrides with empty params
141
    ($LOGFILEOUT, $stdoutLogPtr) = _reopenStdoutScalarHandle($LOGFILEOUT, $stdoutLogPtr);
142
    try {
143
        Koha::Logger->setConsoleVerbosity('WARNNNG');
144
        die "We should have died";
145
    } catch {
146
        ok($_ =~ /verbosity must be a positive or negative digit/, "Bad \$verbosiness, but got instructions on how to properly give \$verbosiness");
147
    };
148
    $logger = Koha::Logger->get({category => "test-is-fun-6"});
149
    _loggerBlarbAllLevels($logger);
150
    $log = t::Koha::Logger::slurpLog('wantArray');
151
    @stdoutLog = split("\n", $stdoutLogHandle);
152
    is(scalar(@stdoutLog), 0,    'Bad config, defaulting. Stdout not printed to in default mode.');
153
    ok($log->[0]     =~ /warn/,  'Bad config, defaulting. file   - warn ok');
154
    ok($log->[1]     =~ /error/, 'Bad config, defaulting. file   - error ok');
155
    ok($log->[2]     =~ /fatal/, 'Bad config, defaulting. file   - fatal ok');
156
    t::Koha::Logger::clearLog();
157
158
    close($LOGFILEOUT);
159
}
160
161
#### END OF Test for KD976 - Koha::Logger overload configuration for command line scripts verbosity levels ####
162
###############################################################################################################
163
164
sub _loggerBlarbAllLevels {
165
    my ($logger) = @_;
166
    $logger->trace('trace');
167
    $logger->debug('debug');
168
    $logger->info('info');
169
    $logger->warn('warn');
170
    $logger->error('error');
171
    $logger->fatal('fatal');
172
}
173
sub _reopenStdoutScalarHandle {
174
    my ($LOGFILEOUT, $pointerToScalar) = @_;
175
    $$pointerToScalar = '';
176
    close($LOGFILEOUT) if $LOGFILEOUT;
177
    open($LOGFILEOUT, '>', $pointerToScalar) or die $!;
178
    $LOGFILEOUT->autoflush ( 1 );
179
    select $LOGFILEOUT; #Use this as the default print target, so Console appender is redirected to this logfile
180
    return ($LOGFILEOUT, $pointerToScalar);
181
}
59
182
60
done_testing();
183
done_testing();
61
- 

Return to bug 16312