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

(-)a/Koha/Logger.pm (+91 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 199-208 sub _recheck_logfile { # recheck saved logfile when logging message Link Here
199
    return -w $log;
204
    return -w $log;
200
}
205
}
201
206
207
=head2 setConsoleVerbosity
208
209
    Koha::Logger->setConsoleVerbosity($verbosity);
210
211
Sets all Koha::Loggers to use also the console for logging and adjusts their verbosity by the given verbosity.
212
213
=USAGE
214
215
Do deploy verbose mode in a commandline script, add the following code:
216
217
    use C4::Context;
218
    use Koha::Logger;
219
    C4::Context->setCommandlineEnvironment();
220
    Koha::Logger->setConsoleVerbosity( 1 || -3 || 'WARN' || ... );
221
222
=PARAMS
223
224
@param {String or Signed Integer} $verbosity,
225
                if $verbosity is 0, no adjustment is made,
226
                If $verbosity is > 1, log level is decremented by that many steps towards TRACE
227
                If $verbosity is < 0, log level is incremented by that many steps towards FATAL
228
                If $verbosity is one of log levels, log level is set to that level.
229
                If $verbosity is undef, clear all overrides.
230
231
=cut
232
233
sub setConsoleVerbosity {
234
    if ($_[0] eq __PACKAGE__ || blessed($_[0]) && $_[0]->isa('Koha::Logger') ) {
235
        shift(@_); #Compensate for erratic calling styles.
236
    }
237
    my ($verbosity) = @_;
238
239
    if (defined($verbosity)) { #Tell all Koha::Loggers to use a console logger as well
240
        unless ($verbosity =~ /^-?\d+$/ ||
241
                $verbosity =~ /^(?:FATAL|ERROR|WARN|INFO|DEBUG|TRACE)$/) {
242
            my @cc = caller(0);
243
            die $cc[3]."($verbosity):> \$verbosity must be a positive or negative digit, or a valid Log::Log4perl log level, eg. FATAL, ERROR, WARN, ...";
244
        }
245
        $ENV{LOG4PERL_TO_CONSOLE} = 1;
246
247
        $ENV{LOG4PERL_VERBOSITY_CHANGE} = $verbosity if defined($verbosity);
248
    }
249
    else {
250
        delete $ENV{LOG4PERL_TO_CONSOLE};
251
        delete $ENV{LOG4PERL_VERBOSITY_CHANGE};
252
    }
253
}
254
255
=head2 _checkLoggerOverloads
256
257
Checks if there are Environment variables that should overload configured behaviour
258
259
=cut
260
261
# Define a stdout appender. I wonder how can I load a PatternedLayout from log4perl.conf here?
262
my $commandlineScreen =  Log::Log4perl::Appender->new(
263
                             "Log::Log4perl::Appender::Screen",
264
                             name      => "commandlineScreen",
265
                             stderr    => 0);
266
my $commandlineLayout = Log::Log4perl::Layout::PatternLayout->new( #I want this to be defined in log4perl.conf instead :(
267
                   "%d %M{2}> %m %n");
268
$commandlineScreen->layout($commandlineLayout);
269
270
sub _checkLoggerOverloads {
271
    my ($self) = @_;
272
    return unless blessed($self->{logger}) && $self->{logger}->isa('Log::Log4perl::Logger');
273
274
    if ($ENV{LOG4PERL_TO_CONSOLE}) {
275
        $self->{logger}->add_appender($commandlineScreen);
276
    }
277
    if ($ENV{LOG4PERL_VERBOSITY_CHANGE}) {
278
        if ($ENV{LOG4PERL_VERBOSITY_CHANGE} =~ /^-?(\d)$/) {
279
            if ($ENV{LOG4PERL_VERBOSITY_CHANGE} > 0) {
280
                $self->{logger}->dec_level( $1 );
281
            }
282
            elsif ($ENV{LOG4PERL_VERBOSITY_CHANGE} < 0) {
283
                $self->{logger}->inc_level( $1 );
284
            }
285
        }
286
        else {
287
            $self->{logger}->level( $ENV{LOG4PERL_VERBOSITY_CHANGE} );
288
        }
289
    }
290
}
291
202
=head1 AUTHOR
292
=head1 AUTHOR
203
293
204
Kyle M Hall, E<lt>kyle@bywatersolutions.comE<gt>
294
Kyle M Hall, E<lt>kyle@bywatersolutions.comE<gt>
205
Marcel de Rooy, Rijksmuseum
295
Marcel de Rooy, Rijksmuseum
296
Olli-Antti Kivilahti, E<lt>olli-antti.kivilahti@jns.fiE<gt>
206
297
207
=cut
298
=cut
208
299
(-)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