From b7db004b30a4b6e63caa8ad45e6ae5f2493f0cac Mon Sep 17 00:00:00 2001 From: Chris Cormack Date: Sat, 29 Dec 2012 11:50:07 +1300 Subject: [PATCH] DO NOT USE - Partial rewrite of Logger http://bugs.koha-community.org/show_bug.cgi?id=8190 --- Koha/Utils/Logger.pm | 195 ++++++++++++++++++++++++++++---------------------- t/Logger.t | 12 ++-- 2 files changed, 115 insertions(+), 92 deletions(-) diff --git a/Koha/Utils/Logger.pm b/Koha/Utils/Logger.pm index e8c0b91..ad277fe 100644 --- a/Koha/Utils/Logger.pm +++ b/Koha/Utils/Logger.pm @@ -1,54 +1,59 @@ package Koha::Utils::Logger; +use Log::Log4perl qw(:levels get_logger); use Modern::Perl; -use Log::LogLite; + +Log::Log4perl->wrapper_register(__PACKAGE__); use base 'Exporter'; + +our $log; our @EXPORT_OK = qw($log); -my $UNUSABLE_LOG_LEVEL = 1; -my $CRITICAL_LOG_LEVEL = 2; -my $ERROR_LOG_LEVEL = 3; -my $WARNING_LOG_LEVEL = 4; -my $NORMAL_LOG_LEVEL = 5; -my $INFO_LOG_LEVEL = 6; -my $DEBUG_LOG_LEVEL = 7; - -my $LEVEL_STR = { - $UNUSABLE_LOG_LEVEL => 'UNUS ', - $CRITICAL_LOG_LEVEL => 'CRIT ', - $ERROR_LOG_LEVEL => 'ERROR ', - $WARNING_LOG_LEVEL => 'WARN ', - $NORMAL_LOG_LEVEL => 'NORMAL', - $INFO_LOG_LEVEL => 'INFO ', - $DEBUG_LOG_LEVEL => 'DEBUG ', +our $LEVEL_STR = { + 1 => $FATAL, + 2 => 'CRIT', + 3 => $ERROR, + 4 => $WARN, + 5 => 'NORMAL', + 6 => $INFO, + 7 => $DEBUG, + 8 => $TRACE, }; use Data::Dumper; -our $log = undef; - sub new { my ( $proto, $params ) = @_; + if ( Log::Log4perl->initialized() and not defined $params->{file} ) { - return $log - if $log - and ( not defined $params->{file} - or not defined $log->{FILE_PATH} - or $params->{file} eq $log->{FILE_PATH} ); - my $class = ref($proto) || $proto; - my $self = {}; - my $LOG_PATH = defined $ENV{KOHA_LOG} ? $ENV{KOHA_LOG} : undef; - $self->{FILE_PATH} = defined $params->{file} ? $params->{file} : $LOG_PATH; - $self->{LEVEL} = defined $params->{level} ? $params->{level} : $INFO_LOG_LEVEL; - $self->{LOGGED_MESSAGES} = []; - - if ( not defined $self->{FILE_PATH} ) { - return bless( $self, $class ); + # we have already initiliased our logger + # and are not trying to change path } - eval { $self->{LOGGER} = Log::LogLite->new( $self->{FILE_PATH}, $self->{LEVEL} ); }; - die "Log system is not correctly configured ($@)" if $@; - return bless( $self, $class ); + else { + # we have to initialise + my $LOG_PATH = defined $ENV{KOHA_LOG} ? $ENV{KOHA_LOG} : undef; + $LOG_PATH = $params->{file} + if defined $params->{file}; + + # set up our custom log leves CRIT and NORMAL + Log::Log4perl::Logger::create_custom_level( 'CRIT', 'FATAL'); + Log::Log4perl::Logger::create_custom_level( 'NORMAL', 'WARN' ); + my $config = <<"END"; + log4perl.logger = INFO, Main + log4perl.appender.Main = Log::Log4perl::Appender::File + log4perl.appender.Main.filename = $LOG_PATH + log4perl.appender.Main.mode=append + log4perl.appender.Main.layout = Log::Log4perl::Layout::PatternLayout + log4perl.appender.Main.layout.ConversionPattern=[%d] %p - %M - %m - %l%n +END + Log::Log4perl->init( \$config ); + } + my $log = Log::Log4perl->get_logger('Main'); + $log->level( $params->{level} ) + if defined $params->{level}; # change level if we have passed one + #bless $log, $proto; + return $log; } sub _write { @@ -56,7 +61,11 @@ sub _write { if ( not $self->{LOGGER} ) { if ( $log_level <= $self->{LEVEL} ) { - print STDERR "[" . localtime() . "] " . "$LEVEL_STR->{$log_level}: " . $msg . ( $cb ? " (" . $cb . ")" : "" ) . "\n"; + print STDERR "[" + . localtime() . "] " + . "$LEVEL_STR->{$log_level}: " + . $msg + . ( $cb ? " (" . $cb . ")" : "" ) . "\n"; } return; } @@ -68,61 +77,72 @@ sub _write { $self->{LOGGER}->write( $msg, $log_level ); if ( $log_level <= $self->{LEVEL} ) { - my $message = "[" . localtime() . "] " . "$LEVEL_STR->{$log_level}: " . $msg . ( $cb ? " (" . $cb . ")" : "" ) . "\n"; + my $message = "[" + . localtime() . "] " + . "$LEVEL_STR->{$log_level}: " + . $msg + . ( $cb ? " (" . $cb . ")" : "" ) . "\n"; push( @{ $self->{LOGGED_MESSAGES} }, $message ); } } -sub unusable { - my ( $self, $msg, $dump ) = @_; - my $cb = $self->_called_by(); - $self->_write( $msg, $UNUSABLE_LOG_LEVEL, $dump, $cb ); -} - -sub critical { - my ( $self, $msg, $dump ) = @_; - my $cb = $self->_called_by(); - $self->_write( $msg, $CRITICAL_LOG_LEVEL, $dump, $cb ); -} - -sub error { - my ( $self, $msg, $dump ) = @_; - my $cb = $self->_called_by(); - $self->_write( $msg, $ERROR_LOG_LEVEL, $dump, $cb ); -} - -sub warning { - my ( $self, $msg, $dump ) = @_; - my $cb = $self->_called_by(); - $self->_write( $msg, $WARNING_LOG_LEVEL, $dump, $cb ); -} - -sub log { - my ( $self, $msg, $dump ) = @_; - $self->_write( $msg, $NORMAL_LOG_LEVEL, $dump ); -} - -sub normal { - my ( $self, $msg, $dump ) = @_; - $self->_write( $msg, $NORMAL_LOG_LEVEL, $dump ); -} - -sub info { - my ( $self, $msg, $dump ) = @_; - $self->_write( $msg, $INFO_LOG_LEVEL, $dump ); -} - -sub debug { - my ( $self, $msg, $dump ) = @_; - $self->_write( $msg, $DEBUG_LOG_LEVEL, $dump ); -} +#sub unusable { +# my ( $self, $msg, $dump ) = @_; +# my $cb = $self->_called_by(); +# $self->_write( $msg, $UNUSABLE_LOG_LEVEL, $dump, $cb ); +#} + +#sub critical { +# my ( $self, $msg, $dump ) = @_; +# my $cb = $self->_called_by(); +# $self->_write( $msg, $CRITICAL_LOG_LEVEL, $dump, $cb ); +#} + +# sub error { + # my ( $self, $msg, $dump ) = @_; +# my $cb = $self->_called_by(); +# $self->_write( $msg, $ERROR_LOG_LEVEL, $dump, $cb ); + +#} + +#sub warning { +# my ( $self, $msg, $dump ) = @_; +# my $cb = $self->_called_by(); +# $self->_write( $msg, $WARNING_LOG_LEVEL, $dump, $cb ); +#} + +#sub log { +# my ( $self, $msg, $dump ) = @_; +# $self->_write( $msg, $NORMAL_LOG_LEVEL, $dump ); +#} + +#sub normal { +# my ( $self, $msg, $dump ) = @_; +# $self->_write( $msg, $NORMAL_LOG_LEVEL, $dump ); +#} + +#sub info { +# my ( $self, $msg, $dump ) = @_; +# $self->_write( $msg, $INFO_LOG_LEVEL, $dump ); +#} + +#sub debug { +# my ( $self, $msg, $dump ) = @_; +# $self->_write( $msg, $DEBUG_LOG_LEVEL, $dump ); +#} sub level { +die "not calling right thing"; + warn "YO"; my $self = shift; - - return $self->{LOGGER} - ? $self->{LOGGER}->level(@_) - : ( $self->{LEVEL} = @_ ? shift : $self->{LEVEL} ); + my $level = shift; + if ($level){ + $self->level( $LEVEL_STR->{ @_ } ); + return $level; + } + else { + return 1; #return the level here + } } sub _called_by { @@ -143,7 +163,10 @@ sub _called_by { my $str = ""; while (1) { - ( $pack, $file, $line, $subr, $has_args, $wantarray, $evaltext, $is_require, $hints, $bitmask ) = caller($depth); + ( + $pack, $file, $line, $subr, $has_args, + $wantarray, $evaltext, $is_require, $hints, $bitmask + ) = caller($depth); unless ( defined($subr) ) { last; } diff --git a/t/Logger.t b/t/Logger.t index 1e42180..735da71 100644 --- a/t/Logger.t +++ b/t/Logger.t @@ -16,7 +16,7 @@ use_ok('Koha::Utils::Logger'); isnt(C4::Context->preference("LogLevel"), undef, "Check LogLevel syspref"); use Koha::Utils::Logger qw/$log/; is($log, undef, "Check \$log is undef"); -$log = Koha::Utils::Logger->new({level => 3}); +$log = Koha::Utils::Logger->new({level => 'ERROR' }); isnt($log, undef, "Check \$log is not undef"); @@ -24,10 +24,10 @@ my @lines = (); $log->error( "an error string"); $log->normal( "a normal string"); @lines = get_contains( $logfile ); -is(grep (/an error string/, @lines), 1, "check error string with level 3"); -is(grep (/a normal string/, @lines), 0, "check normal string with level 3"); +is(grep (/an error string/, @lines), 1, "check error string with level ERROR"); +is(grep (/a normal string/, @lines), 0, "check normal string with level ERROR"); truncate_file($logfile); -$log->level(5); +$log->level('NORMAL'); $log->error( "an error string"); $log->normal( "a normal string"); test_calledby( "test calledby" ); @@ -36,9 +36,9 @@ my $struct = { b => "bbbbb", c => "ccccc" }; -$log->warning($struct, 1); +$log->warn($struct, 1); @lines = get_contains( $logfile ); -is(grep (/an error string/, @lines), 1, "check error string with level 5"); +is(grep (/an error string/, @lines), 1, "check error string with level NORMAL"); is(grep (/a normal string/, @lines), 1, "check normal string with level 5"); is(grep (/test_calledby/, @lines), 1, "check calledby string with level 5"); is(grep (/WARN/, @lines), 1, "check WARN string with dump"); -- 1.7.10.4