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

(-)a/Koha/Logger.pm (+86 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
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
}
249
250
=head2 _checkLoggerOverloads
251
252
Checks if there are Environment variables that should overload configured behaviour
253
254
=cut
255
256
# Define a stdout appender. I wonder how can I load a PatternedLayout from log4perl.conf here?
257
my $commandlineScreen =  Log::Log4perl::Appender->new(
258
                             "Log::Log4perl::Appender::Screen",
259
                             name      => "commandlineScreen",
260
                             stderr    => 0);
261
my $commandlineLayout = Log::Log4perl::Layout::PatternLayout->new( #I want this to be defined in log4perl.conf instead :(
262
                   "%d (%F:%L)> %m %n");
263
$commandlineScreen->layout($commandlineLayout);
264
265
sub _checkLoggerOverloads {
266
    my ($self) = @_;
267
    return unless blessed($self->{logger}) && $self->{logger}->isa('Log::Log4perl::Logger');
268
269
    if ($ENV{LOG4PERL_TO_CONSOLE}) {
270
        $self->{logger}->add_appender($commandlineScreen);
271
    }
272
    if ($ENV{LOG4PERL_VERBOSITY_CHANGE}) {
273
        if ($ENV{LOG4PERL_VERBOSITY_CHANGE} =~ /^-?(\d)$/) {
274
            if ($ENV{LOG4PERL_VERBOSITY_CHANGE} > 0) {
275
                $self->{logger}->dec_level( $1 );
276
            }
277
            elsif ($ENV{LOG4PERL_VERBOSITY_CHANGE} < 0) {
278
                $self->{logger}->inc_level( $1 );
279
            }
280
        }
281
        else {
282
            $self->{logger}->level( $ENV{LOG4PERL_VERBOSITY_CHANGE} );
283
        }
284
    }
285
}
286
202
=head1 AUTHOR
287
=head1 AUTHOR
203
288
204
Kyle M Hall, E<lt>kyle@bywatersolutions.comE<gt>
289
Kyle M Hall, E<lt>kyle@bywatersolutions.comE<gt>
205
Marcel de Rooy, Rijksmuseum
290
Marcel de Rooy, Rijksmuseum
291
Olli-Antti Kivilahti, E<lt>olli-antti.kivilahti@jns.fiE<gt>
206
292
207
=cut
293
=cut
208
294
(-)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 / +122 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
    ($LOGFILEOUT, $stdoutLogPtr) = _reopenStdoutScalarHandle($LOGFILEOUT, $stdoutLogPtr);
141
    try {
142
        Koha::Logger->setConsoleVerbosity('WARNNNG');
143
        die "We should have died";
144
    } catch {
145
        ok($_ =~ /verbosity must be a positive or negative digit/, "Bad \$verbosiness, but got instructions on how to properly give \$verbosiness");
146
    };
147
    $logger = Koha::Logger->get({category => "test-is-fun-6"});
148
    _loggerBlarbAllLevels($logger);
149
    $log = t::Koha::Logger::slurpLog('wantArray');
150
    @stdoutLog = split("\n", $stdoutLogHandle);
151
    ok($log->[0]     =~ /fatal/, 'Bad config, defaulting. file   - fatal ok');
152
    ok($stdoutLog[0] =~ /fatal/, 'Bad config, defaulting. stdout - fatal ok');
153
    t::Koha::Logger::clearLog();
154
155
    close($LOGFILEOUT);
156
}
157
158
#### END OF Test for KD976 - Koha::Logger overload configuration for command line scripts verbosity levels ####
159
###############################################################################################################
160
161
sub _loggerBlarbAllLevels {
162
    my ($logger) = @_;
163
    $logger->trace('trace');
164
    $logger->debug('debug');
165
    $logger->info('info');
166
    $logger->warn('warn');
167
    $logger->error('error');
168
    $logger->fatal('fatal');
169
}
170
sub _reopenStdoutScalarHandle {
171
    my ($LOGFILEOUT, $pointerToScalar) = @_;
172
    $$pointerToScalar = '';
173
    close($LOGFILEOUT) if $LOGFILEOUT;
174
    open($LOGFILEOUT, '>', $pointerToScalar) or die $!;
175
    $LOGFILEOUT->autoflush ( 1 );
176
    select $LOGFILEOUT; #Use this as the default print target, so Console appender is redirected to this logfile
177
    return ($LOGFILEOUT, $pointerToScalar);
178
}
59
179
60
done_testing();
180
done_testing();
61
- 

Return to bug 16312