@@ -, +, @@ --- Koha/Log.pm | 405 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++ debian/control | 2 + t/Koha_Log.t | 77 +++++++++++ 3 files changed, 484 insertions(+) create mode 100644 Koha/Log.pm create mode 100755 t/Koha_Log.t --- a/Koha/Log.pm +++ a/Koha/Log.pm @@ -0,0 +1,405 @@ +package Koha::Log; + +# Copyright 2014 Catalyst IT +# +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. +# +# Koha is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with Koha; if not, see . + +use Modern::Perl; +use Log::Contextual qw(set_logger with_logger); +use Exporter::Declare; +use base 'Log::Contextual'; + +exports qw(with_debug with_logger create_logger set_default_logger); + +=head1 NAME + +Koha::Log - Logging for Koha + +=head1 SYNOPSIS + + # Main script + use Koha::Log; + # optionally + Koha::Log::set_default_logger('File', {filename => $LOG_FILE}); + + log_error { "Error" }; + log_warn { "Warn" }; + log_info { "Info" }; + + # Some module + use Koha::Log; + log_error { "Error" }; + +=head1 DESCRIPTION + + This is a combination of Log::Contextual and customised Log:Dispatcher + Why? + 1. Because it uses code blocks to log, so complex debugging can be left in + without any performance penalty + 2. Some useful things can be done + + Out of the box it logs to STDERR + +=head1 LOG LEVELS + + We support log levels of debug info warn error fatal + Not sure how useful is fatal; + trace level is TODO + + Log functions are log_I + +=head1 Log::Contextual FUNCTIONS + +By default, log_* functions are exported. For the full list see C + +=cut + +my $default_logger; + +sub arg_default_logger { + return $_[1] || ($default_logger ||= create_logger()); +} +sub arg_levels { [qw(debug trace info warn error fatal)] } +sub default_import { ':log' } + +=head1 FUNCTIONS + +=head2 create_logger( Sink1 => {params}, Sink2 => {params} ) + + If no sinks are given, Stderr is assumed + +=head3 Sinks + +Sinks are C module names, eg File, Syslog etc +We added two more: + C which is a shortcut for Screen stderr => 0 + C which is a shortcut for Screen stderr => 1 + + Default sink parameters: + C - if env KOHA_DEBUG is set to true valu then 'debug' else 'info' + C - lower case sink module name + + Filename rules for C) sink: + Filenames with absolute paths are honoured + otherwise files are placed in koha config logdir + + Default C parameter for C) sink is I + +=cut + +sub create_logger { + my %sink_defs = @_ ? @_ : (Stderr => {}); + my $logger = Koha::Log::Dispatch->new; + while (my ($sink, $params) = each %sink_defs) { + $logger->add_sink($sink, $params); + } + return $logger; +} + +=head1 DEFAULT LOGGER FUNCTIONS + +Following functions operate on the default logger. +Default logger should be used most of the time. + +=head2 set_default_logger( Sink1 => {params}, Sink2 => {params} ) + + Calls C and sets it as the default. + Should probably be used only in the main script. + +=cut + +sub set_default_logger { + $default_logger = create_logger(@_); + set_logger($default_logger); +} + +sub restore_default_logger { + set_logger($default_logger); +} + +=head2 add_sink( Sink, {params}, $force ) +=head2 remove_sink( sink_name ) +=head2 with_debug { code...} Sink1 [ => {params}], Sink2 ... + + C method proxies, called on the default logger + +=cut + +sub add_sink { + $default_logger->add_sink(@_); +} + +sub remove_sink { + my ($sink_name) = @_; + $default_logger->remove( lc $sink_name ); +} + +sub with_debug (&@) { + my $code = \&{shift @_}; + $default_logger->with_debug($code, @_); +} + +package Koha::Log::Dispatch; + +=head1 LOGGER CLASS + +C returns a loger class based on C + +=cut + +use Modern::Perl; +use Carp; +use Class::Load 'load_class'; + +use C4::Context; + +use base 'Log::Dispatch'; + +my %ALL_LOGGER_PARAMS = ( + newline => 1, + min_level => $ENV{KOHA_DEBUG} ? 'debug' : 'info', +); + +my %LOGGER_PARAMS = ( + Stdout => {stderr => 0}, + Stderr => {stderr => 1}, + Syslog => {facility => 'user'}, +); + +=head1 LOGGER METHODS + +=head2 outputs() + + Returns hashref {sink_name => sink_object...} + +=cut + +sub outputs { + my $self = shift; + return $self->{outputs}; +} + +=head2 set_level(log_level, @sink_names) + + Sets (minimum) log level for all named sinks (outputs) + If no named sinks are specified, all associated sinks are affected. + +=cut + +sub set_level { + my $self = shift; + my $level = shift or croak "No level specified"; + + my @outputs = @_ ? map ($self->output($_), @_) : values (%{ $self->outputs }); + $_->{min_level} = $_->_level_as_number($level) foreach @outputs; +} + +=head2 get_levels() + + Returns hashref {sink_name => log_level...} + +=cut + +sub get_levels { + my $self = shift; + + my @outputs = @_ ? map ($self->output($_), @_) : values (%{ $self->outputs }); + return { map { $_->name => $_->min_level } @outputs }; +} + +=head2 add_sink( Sink, {params}, $force ) + + Creates a C object, and calls C + If sink with the name altready exists it returns, unless $force is true, + in which case existing sink is replaced with a new one. + +=cut + +sub add_sink { + my $self = shift; + my ($sink, $params, $force) = @_; + + my $sink_params = $LOGGER_PARAMS{$sink} || {}; + my $sink_name = $params->{name} ||= lc $sink; + + if ( $self->output($sink_name) ) { + return unless $force; + $self->remove( $sink_name ); + } + + $params ||= {}; + if (my $filename = $params->{filename}) { + $params->{filename} = C4::Context->config("logdir") . "/$filename" + unless $filename =~ m!^[/.]!o; + } + + $sink = 'Screen' if $sink eq 'Stdout' || $sink eq 'Stderr'; + my $sink_class = "Log::Dispatch::$sink"; + load_class $sink_class; + $self->add( $sink_class->new( %ALL_LOGGER_PARAMS, %$sink_params, %$params ) ); + return $sink_name; +} + +=head2 with_debug( code_ref, Sink1 [ => {params}], Sink2 ... ) + + Executes code within a debug context + If Sink => params are given, those are used for debug logging in addition + to eny existing sinks with debug level. Otherwise all associated sinks + (outputs) are upgraded temporarily to debug level. + + See B below + +=cut + +sub with_debug { + my $self = shift; + my $code = shift; + + my $current_levels = $self->get_levels; + + my @sink; + my @extra_logger; + if (@_) { + while (my $sink = shift @_) { + # next if ref $sink; + my $params = {}; + $params = shift @_ if ref $_[0]; + my $sink_name = $params->{name} || lc $sink; + unless ($self->output($sink_name)) { + $params->{min_level} = 'debug'; + $self->add_sink($sink, $params); + push @extra_logger, $sink_name; + } + push @sink, $sink_name; + } + } + else { + @sink = keys %$current_levels; + } + $self->set_level('debug', @sink); + $code->(); + $self->remove($_) foreach @extra_logger; + while (my ($name, $level) = each %$current_levels) { + $self->set_level($level, $name); + } +} + + +=head1 USAGE + + The simplest example: + + use Koha::Log; + do things(); + log_info { "This will show in STDERR" }; + log_debug { "This will not show in STDERR" }; + + A less simple example: + + use Koha::Log qw(:log set_default_logger) + my %sinks = ( + 'File' => {filename => 'my.log'}, + ); + set_default_logger(%sinks); + + # In a module down below + use Koha::Log; + do things(); + log_info { "This will show in my.log" }; + log_debug { "This will not show in my.log" }; + + An example with multiple sinks: + + use Koha::Log qw(:log set_default_logger) + my %sinks = ( + 'Stderr' => {min_level => 'debug'}, + 'Syslog' => {}, + 'File' => {filename => 'my.log'}, + ); + set_default_logger(%sinks); + + # In a module down below + use Koha::Log; + do things(); + log_info { "This will show everywhere" }; + log_debug { "This will show in STDERR" }; + + Enable debug messages: + KOHA_DEBUG=1 some_koha_script.pl + + or in Apache: + SetEnv KOHA_DEBUG=1 + +=cut + +=head1 ADVANCED USAGE + + Enable debug messages just for a piece of code: + + use Koha::Log qw(:log set_default_logger) + my %sinks = ( + 'File' => {filename => 'my.log'}, + ); + set_default_logger(%sinks); + + # In a module down below + use Koha::Log qw(:log with_debug) + do things(); + log_debug { "This will not show" }; + ... + with_debug { + do other_things(); + log_debug {"This will show"}; + }; + + This will make the block surounded by with_debug {} output debug to my.log + Alternatively: + + with_debug { + do other_things(); + log_debug {"This will show"}; + } 'Stderr'; + + will leave my.log at 'info' level, and output debug (and other log levels) to STDERR. + + Special logging: + + use Koha::Log qw(:log set_default_logger) + my %sinks = ( + 'File' => {filename => 'my.log'}, + ); + set_default_logger(%sinks); + + # In a module down below + use Koha::Log qw(:log create_logger with_logger) + do things(); + log_warn { "This will show in my.log" }; + ... + my $special_logger = create_logger('File' => {filename => 'my_special.log}); + with_logger $special_logger => sub { + log_warn { "This will show in my_special.log" }; + }; + + This will make the block surounded by with_debug {} output debug to my.log + +=head1 TO DO + + * Add support for Email and possibly other sinks + * Integrate C4::Log + +=cut + +1; --- a/debian/control +++ a/debian/control @@ -65,6 +65,7 @@ Build-Depends: libalgorithm-checkdigits-perl, liblocale-currency-format-perl, liblocale-maketext-lexicon-perl, liblocale-po-perl, + liblog-contextual-perl, liblwp-protocol-https-perl|libwww-perl (<6.02), libio-socket-ssl-perl, libmail-sendmail-perl, libmarc-charset-perl, @@ -263,6 +264,7 @@ Depends: libalgorithm-checkdigits-perl, liblocale-currency-format-perl, liblocale-maketext-lexicon-perl, liblocale-po-perl, + liblog-contextual-perl, liblwp-protocol-https-perl|libwww-perl (<6.02), libio-socket-ssl-perl, libmail-sendmail-perl, libmarc-charset-perl, --- a/t/Koha_Log.t +++ a/t/Koha_Log.t @@ -0,0 +1,77 @@ +#!/usr/bin/perl + +use strict; +use warnings; +use autodie; + +use Test::More tests => 6; +use Test::Output; + +my $LOG_FILE = '/tmp/koha_log_test.log'; +my $DEBUG_LOG_FILE = '/tmp/koha_log_debug.log'; +my $SPECIAL_LOG_FILE = '/tmp/koha_log_special.log'; + +BEGIN { + use_ok('Koha::Log', ":log", "with_logger", "with_debug", "create_logger", "set_default_logger"); +} + +my %sinks = ( + 'Stderr' => {}, + 'Stdout' => {min_level => 'debug'}, + 'Syslog' => {}, + 'File' => {filename => $LOG_FILE}, +); + +remove_log_files(); + +set_default_logger(%sinks); + +my $expect = join '', map "$_\n", "Error", "Warn", "Info", "Koha::Log::Test::test()"; +my $expect_debug = join '', map "$_\n", "Debug1", "Debug2", "Debug3"; + +stdout_is { stderr_is { + log_error { "Error" }; + log_warn { "Warn" }; + log_info { "Info" }; + + Koha::Log::Test::test(); + + log_debug {"Debug1"}; + with_debug { + log_debug {"Debug2"}; + } 'Stderr', 'File', {filename => $DEBUG_LOG_FILE, name => 'debug'}; + log_debug {"Debug3"}; + + my $special_logger = create_logger('File' => {filename => $SPECIAL_LOG_FILE}); + with_logger $special_logger => sub { + log_info { "Special" }; + }; + + log_info { "Last" }; +} $expect."Debug2\n"."Last\n", "logged to stderr" } $expect.$expect_debug."Last\n", "logged to stdout"; + +check_log($LOG_FILE, $expect."Last\n"); +check_log($DEBUG_LOG_FILE, "Debug2\n"); +check_log($SPECIAL_LOG_FILE, "Special\n"); + +remove_log_files(); + +sub check_log { + my ($file, $content) = @_; + + open (my $log, "<", $file); + my $logged = join '', <$log>; + is ($logged, $content, "logged to file $file"); +} + +sub remove_log_files { + -f $_ && unlink $_ foreach $LOG_FILE, $DEBUG_LOG_FILE, $SPECIAL_LOG_FILE; +} + +package Koha::Log::Test; + +use Koha::Log; + +sub test { + log_info { "Koha::Log::Test::test()" }; +} --