Line 0
Link Here
|
|
|
1 |
package Koha::Log; |
2 |
|
3 |
# Copyright 2014 Catalyst IT |
4 |
# |
5 |
# This file is part of Koha. |
6 |
# |
7 |
# Koha is free software; you can redistribute it and/or modify it |
8 |
# under the terms of the GNU General Public License as published by |
9 |
# the Free Software Foundation; either version 3 of the License, or |
10 |
# (at your option) any later version. |
11 |
# |
12 |
# Koha is distributed in the hope that it will be useful, but |
13 |
# WITHOUT ANY WARRANTY; without even the implied warranty of |
14 |
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
15 |
# GNU General Public License for more details. |
16 |
# |
17 |
# You should have received a copy of the GNU General Public License |
18 |
# along with Koha; if not, see <http://www.gnu.org/licenses>. |
19 |
|
20 |
use Modern::Perl; |
21 |
use Log::Contextual qw(set_logger with_logger); |
22 |
use Exporter::Declare; |
23 |
use base 'Log::Contextual'; |
24 |
|
25 |
exports qw(with_debug with_logger create_logger set_default_logger); |
26 |
|
27 |
=head1 NAME |
28 |
|
29 |
Koha::Log - Logging for Koha |
30 |
|
31 |
=head1 SYNOPSIS |
32 |
|
33 |
# Main script |
34 |
use Koha::Log; |
35 |
# optionally |
36 |
Koha::Log::set_default_logger('File', {filename => $LOG_FILE}); |
37 |
|
38 |
log_error { "Error" }; |
39 |
log_warn { "Warn" }; |
40 |
log_info { "Info" }; |
41 |
|
42 |
# Some module |
43 |
use Koha::Log; |
44 |
log_error { "Error" }; |
45 |
|
46 |
=head1 DESCRIPTION |
47 |
|
48 |
This is a combination of Log::Contextual and customised Log:Dispatcher |
49 |
Why? |
50 |
1. Because it uses code blocks to log, so complex debugging can be left in |
51 |
without any performance penalty |
52 |
2. Some useful things can be done |
53 |
|
54 |
Out of the box it logs to STDERR |
55 |
|
56 |
=head1 LOG LEVELS |
57 |
|
58 |
We support log levels of debug info warn error fatal |
59 |
Not sure how useful is fatal; |
60 |
trace level is TODO |
61 |
|
62 |
Log functions are log_I<level> |
63 |
|
64 |
=head1 Log::Contextual FUNCTIONS |
65 |
|
66 |
By default, log_* functions are exported. For the full list see C<Log::Contextual> |
67 |
|
68 |
=cut |
69 |
|
70 |
my $default_logger; |
71 |
|
72 |
sub arg_default_logger { |
73 |
return $_[1] || ($default_logger ||= create_logger()); |
74 |
} |
75 |
sub arg_levels { [qw(debug trace info warn error fatal)] } |
76 |
sub default_import { ':log' } |
77 |
|
78 |
=head1 FUNCTIONS |
79 |
|
80 |
=head2 create_logger( Sink1 => {params}, Sink2 => {params} ) |
81 |
|
82 |
If no sinks are given, Stderr is assumed |
83 |
|
84 |
=head3 Sinks |
85 |
|
86 |
Sinks are C<Log::Dispatch::*> module names, eg File, Syslog etc |
87 |
We added two more: |
88 |
C<Stdout> which is a shortcut for Screen stderr => 0 |
89 |
C<Stderr> which is a shortcut for Screen stderr => 1 |
90 |
|
91 |
Default sink parameters: |
92 |
C<min_level> - if env KOHA_DEBUG is set to true valu then 'debug' else 'info' |
93 |
C<name> - lower case sink module name |
94 |
|
95 |
Filename rules for C<File>) sink: |
96 |
Filenames with absolute paths are honoured |
97 |
otherwise files are placed in koha config logdir |
98 |
|
99 |
Default C<facility> parameter for C<Syslog>) sink is I<user> |
100 |
|
101 |
=cut |
102 |
|
103 |
sub create_logger { |
104 |
my %sink_defs = @_ ? @_ : (Stderr => {}); |
105 |
my $logger = Koha::Log::Dispatch->new; |
106 |
while (my ($sink, $params) = each %sink_defs) { |
107 |
$logger->add_sink($sink, $params); |
108 |
} |
109 |
return $logger; |
110 |
} |
111 |
|
112 |
=head1 DEFAULT LOGGER FUNCTIONS |
113 |
|
114 |
Following functions operate on the default logger. |
115 |
Default logger should be used most of the time. |
116 |
|
117 |
=head2 set_default_logger( Sink1 => {params}, Sink2 => {params} ) |
118 |
|
119 |
Calls C<create_logger()> and sets it as the default. |
120 |
Should probably be used only in the main script. |
121 |
|
122 |
=cut |
123 |
|
124 |
sub set_default_logger { |
125 |
$default_logger = create_logger(@_); |
126 |
set_logger($default_logger); |
127 |
} |
128 |
|
129 |
sub restore_default_logger { |
130 |
set_logger($default_logger); |
131 |
} |
132 |
|
133 |
=head2 add_sink( Sink, {params}, $force ) |
134 |
=head2 remove_sink( sink_name ) |
135 |
=head2 with_debug { code...} Sink1 [ => {params}], Sink2 ... |
136 |
|
137 |
C<Koha::Log::Dispatch> method proxies, called on the default logger |
138 |
|
139 |
=cut |
140 |
|
141 |
sub add_sink { |
142 |
$default_logger->add_sink(@_); |
143 |
} |
144 |
|
145 |
sub remove_sink { |
146 |
my ($sink_name) = @_; |
147 |
$default_logger->remove( lc $sink_name ); |
148 |
} |
149 |
|
150 |
sub with_debug (&@) { |
151 |
my $code = \&{shift @_}; |
152 |
$default_logger->with_debug($code, @_); |
153 |
} |
154 |
|
155 |
package Koha::Log::Dispatch; |
156 |
|
157 |
=head1 LOGGER CLASS |
158 |
|
159 |
C<create_logger()> returns a loger class based on C<Log::Dispatch> |
160 |
|
161 |
=cut |
162 |
|
163 |
use Modern::Perl; |
164 |
use Carp; |
165 |
use Class::Load 'load_class'; |
166 |
|
167 |
use C4::Context; |
168 |
|
169 |
use base 'Log::Dispatch'; |
170 |
|
171 |
my %ALL_LOGGER_PARAMS = ( |
172 |
newline => 1, |
173 |
min_level => $ENV{KOHA_DEBUG} ? 'debug' : 'info', |
174 |
); |
175 |
|
176 |
my %LOGGER_PARAMS = ( |
177 |
Stdout => {stderr => 0}, |
178 |
Stderr => {stderr => 1}, |
179 |
Syslog => {facility => 'user'}, |
180 |
); |
181 |
|
182 |
=head1 LOGGER METHODS |
183 |
|
184 |
=head2 outputs() |
185 |
|
186 |
Returns hashref {sink_name => sink_object...} |
187 |
|
188 |
=cut |
189 |
|
190 |
sub outputs { |
191 |
my $self = shift; |
192 |
return $self->{outputs}; |
193 |
} |
194 |
|
195 |
=head2 set_level(log_level, @sink_names) |
196 |
|
197 |
Sets (minimum) log level for all named sinks (outputs) |
198 |
If no named sinks are specified, all associated sinks are affected. |
199 |
|
200 |
=cut |
201 |
|
202 |
sub set_level { |
203 |
my $self = shift; |
204 |
my $level = shift or croak "No level specified"; |
205 |
|
206 |
my @outputs = @_ ? map ($self->output($_), @_) : values (%{ $self->outputs }); |
207 |
$_->{min_level} = $_->_level_as_number($level) foreach @outputs; |
208 |
} |
209 |
|
210 |
=head2 get_levels() |
211 |
|
212 |
Returns hashref {sink_name => log_level...} |
213 |
|
214 |
=cut |
215 |
|
216 |
sub get_levels { |
217 |
my $self = shift; |
218 |
|
219 |
my @outputs = @_ ? map ($self->output($_), @_) : values (%{ $self->outputs }); |
220 |
return { map { $_->name => $_->min_level } @outputs }; |
221 |
} |
222 |
|
223 |
=head2 add_sink( Sink, {params}, $force ) |
224 |
|
225 |
Creates a C<Log::Dispatch::Sink> object, and calls C<add()> |
226 |
If sink with the name altready exists it returns, unless $force is true, |
227 |
in which case existing sink is replaced with a new one. |
228 |
|
229 |
=cut |
230 |
|
231 |
sub add_sink { |
232 |
my $self = shift; |
233 |
my ($sink, $params, $force) = @_; |
234 |
|
235 |
my $sink_params = $LOGGER_PARAMS{$sink} || {}; |
236 |
my $sink_name = $params->{name} ||= lc $sink; |
237 |
|
238 |
if ( $self->output($sink_name) ) { |
239 |
return unless $force; |
240 |
$self->remove( $sink_name ); |
241 |
} |
242 |
|
243 |
$params ||= {}; |
244 |
if (my $filename = $params->{filename}) { |
245 |
$params->{filename} = C4::Context->config("logdir") . "/$filename" |
246 |
unless $filename =~ m!^[/.]!o; |
247 |
} |
248 |
|
249 |
$sink = 'Screen' if $sink eq 'Stdout' || $sink eq 'Stderr'; |
250 |
my $sink_class = "Log::Dispatch::$sink"; |
251 |
load_class $sink_class; |
252 |
$self->add( $sink_class->new( %ALL_LOGGER_PARAMS, %$sink_params, %$params ) ); |
253 |
return $sink_name; |
254 |
} |
255 |
|
256 |
=head2 with_debug( code_ref, Sink1 [ => {params}], Sink2 ... ) |
257 |
|
258 |
Executes code within a debug context |
259 |
If Sink => params are given, those are used for debug logging in addition |
260 |
to eny existing sinks with debug level. Otherwise all associated sinks |
261 |
(outputs) are upgraded temporarily to debug level. |
262 |
|
263 |
See B<ADVANCED USAGE> below |
264 |
|
265 |
=cut |
266 |
|
267 |
sub with_debug { |
268 |
my $self = shift; |
269 |
my $code = shift; |
270 |
|
271 |
my $current_levels = $self->get_levels; |
272 |
|
273 |
my @sink; |
274 |
my @extra_logger; |
275 |
if (@_) { |
276 |
while (my $sink = shift @_) { |
277 |
# next if ref $sink; |
278 |
my $params = {}; |
279 |
$params = shift @_ if ref $_[0]; |
280 |
my $sink_name = $params->{name} || lc $sink; |
281 |
unless ($self->output($sink_name)) { |
282 |
$params->{min_level} = 'debug'; |
283 |
$self->add_sink($sink, $params); |
284 |
push @extra_logger, $sink_name; |
285 |
} |
286 |
push @sink, $sink_name; |
287 |
} |
288 |
} |
289 |
else { |
290 |
@sink = keys %$current_levels; |
291 |
} |
292 |
$self->set_level('debug', @sink); |
293 |
$code->(); |
294 |
$self->remove($_) foreach @extra_logger; |
295 |
while (my ($name, $level) = each %$current_levels) { |
296 |
$self->set_level($level, $name); |
297 |
} |
298 |
} |
299 |
|
300 |
|
301 |
=head1 USAGE |
302 |
|
303 |
The simplest example: |
304 |
|
305 |
use Koha::Log; |
306 |
do things(); |
307 |
log_info { "This will show in STDERR" }; |
308 |
log_debug { "This will not show in STDERR" }; |
309 |
|
310 |
A less simple example: |
311 |
|
312 |
use Koha::Log qw(:log set_default_logger) |
313 |
my %sinks = ( |
314 |
'File' => {filename => 'my.log'}, |
315 |
); |
316 |
set_default_logger(%sinks); |
317 |
|
318 |
# In a module down below |
319 |
use Koha::Log; |
320 |
do things(); |
321 |
log_info { "This will show in my.log" }; |
322 |
log_debug { "This will not show in my.log" }; |
323 |
|
324 |
An example with multiple sinks: |
325 |
|
326 |
use Koha::Log qw(:log set_default_logger) |
327 |
my %sinks = ( |
328 |
'Stderr' => {min_level => 'debug'}, |
329 |
'Syslog' => {}, |
330 |
'File' => {filename => 'my.log'}, |
331 |
); |
332 |
set_default_logger(%sinks); |
333 |
|
334 |
# In a module down below |
335 |
use Koha::Log; |
336 |
do things(); |
337 |
log_info { "This will show everywhere" }; |
338 |
log_debug { "This will show in STDERR" }; |
339 |
|
340 |
Enable debug messages: |
341 |
KOHA_DEBUG=1 some_koha_script.pl |
342 |
|
343 |
or in Apache: |
344 |
SetEnv KOHA_DEBUG=1 |
345 |
|
346 |
=cut |
347 |
|
348 |
=head1 ADVANCED USAGE |
349 |
|
350 |
Enable debug messages just for a piece of code: |
351 |
|
352 |
use Koha::Log qw(:log set_default_logger) |
353 |
my %sinks = ( |
354 |
'File' => {filename => 'my.log'}, |
355 |
); |
356 |
set_default_logger(%sinks); |
357 |
|
358 |
# In a module down below |
359 |
use Koha::Log qw(:log with_debug) |
360 |
do things(); |
361 |
log_debug { "This will not show" }; |
362 |
... |
363 |
with_debug { |
364 |
do other_things(); |
365 |
log_debug {"This will show"}; |
366 |
}; |
367 |
|
368 |
This will make the block surounded by with_debug {} output debug to my.log |
369 |
Alternatively: |
370 |
|
371 |
with_debug { |
372 |
do other_things(); |
373 |
log_debug {"This will show"}; |
374 |
} 'Stderr'; |
375 |
|
376 |
will leave my.log at 'info' level, and output debug (and other log levels) to STDERR. |
377 |
|
378 |
Special logging: |
379 |
|
380 |
use Koha::Log qw(:log set_default_logger) |
381 |
my %sinks = ( |
382 |
'File' => {filename => 'my.log'}, |
383 |
); |
384 |
set_default_logger(%sinks); |
385 |
|
386 |
# In a module down below |
387 |
use Koha::Log qw(:log create_logger with_logger) |
388 |
do things(); |
389 |
log_warn { "This will show in my.log" }; |
390 |
... |
391 |
my $special_logger = create_logger('File' => {filename => 'my_special.log}); |
392 |
with_logger $special_logger => sub { |
393 |
log_warn { "This will show in my_special.log" }; |
394 |
}; |
395 |
|
396 |
This will make the block surounded by with_debug {} output debug to my.log |
397 |
|
398 |
=head1 TO DO |
399 |
|
400 |
* Add support for Email and possibly other sinks |
401 |
* Integrate C4::Log |
402 |
|
403 |
=cut |
404 |
|
405 |
1; |