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

(-)a/Koha/Utils/Logger.pm (-86 / +109 lines)
Lines 1-54 Link Here
1
package Koha::Utils::Logger;
1
package Koha::Utils::Logger;
2
2
3
use Log::Log4perl qw(:levels get_logger);
3
use Modern::Perl;
4
use Modern::Perl;
4
use Log::LogLite;
5
6
Log::Log4perl->wrapper_register(__PACKAGE__);
5
7
6
use base 'Exporter';
8
use base 'Exporter';
9
10
our $log;
7
our @EXPORT_OK = qw($log);
11
our @EXPORT_OK = qw($log);
8
12
9
my $UNUSABLE_LOG_LEVEL = 1;
13
our $LEVEL_STR = {
10
my $CRITICAL_LOG_LEVEL = 2;
14
    1 => $FATAL,
11
my $ERROR_LOG_LEVEL    = 3;
15
    2 => 'CRIT',
12
my $WARNING_LOG_LEVEL  = 4;
16
    3 => $ERROR,
13
my $NORMAL_LOG_LEVEL   = 5;
17
    4 => $WARN,
14
my $INFO_LOG_LEVEL     = 6;
18
    5 => 'NORMAL',
15
my $DEBUG_LOG_LEVEL    = 7;
19
    6 => $INFO,
16
20
    7 => $DEBUG,
17
my $LEVEL_STR = {
21
    8 => $TRACE,
18
    $UNUSABLE_LOG_LEVEL => 'UNUS  ',
19
    $CRITICAL_LOG_LEVEL => 'CRIT  ',
20
    $ERROR_LOG_LEVEL    => 'ERROR ',
21
    $WARNING_LOG_LEVEL  => 'WARN  ',
22
    $NORMAL_LOG_LEVEL   => 'NORMAL',
23
    $INFO_LOG_LEVEL     => 'INFO  ',
24
    $DEBUG_LOG_LEVEL    => 'DEBUG ',
25
};
22
};
26
23
27
use Data::Dumper;
24
use Data::Dumper;
28
25
29
our $log = undef;
30
31
sub new {
26
sub new {
32
    my ( $proto, $params ) = @_;
27
    my ( $proto, $params ) = @_;
28
    if ( Log::Log4perl->initialized() and not defined $params->{file} ) {
33
29
34
    return $log
30
        # we have already initiliased our logger
35
      if $log
31
        # and are not trying to change path
36
          and (  not defined $params->{file}
37
              or not defined $log->{FILE_PATH}
38
              or $params->{file} eq $log->{FILE_PATH} );
39
    my $class    = ref($proto) || $proto;
40
    my $self     = {};
41
    my $LOG_PATH = defined $ENV{KOHA_LOG} ? $ENV{KOHA_LOG} : undef;
42
    $self->{FILE_PATH} = defined $params->{file}  ? $params->{file}  : $LOG_PATH;
43
    $self->{LEVEL}     = defined $params->{level} ? $params->{level} : $INFO_LOG_LEVEL;
44
    $self->{LOGGED_MESSAGES} = [];
45
46
    if ( not defined $self->{FILE_PATH} ) {
47
        return bless( $self, $class );
48
    }
32
    }
49
    eval { $self->{LOGGER} = Log::LogLite->new( $self->{FILE_PATH}, $self->{LEVEL} ); };
33
    else {
50
    die "Log system is not correctly configured ($@)" if $@;
34
        # we have to initialise
51
    return bless( $self, $class );
35
        my $LOG_PATH = defined $ENV{KOHA_LOG} ? $ENV{KOHA_LOG} : undef;
36
        $LOG_PATH = $params->{file}
37
          if defined $params->{file};
38
39
        # set up our custom log leves CRIT and NORMAL
40
        Log::Log4perl::Logger::create_custom_level( 'CRIT', 'FATAL');
41
        Log::Log4perl::Logger::create_custom_level( 'NORMAL', 'WARN' );
42
        my $config = <<"END";
43
	  log4perl.logger = INFO, Main
44
	  log4perl.appender.Main = Log::Log4perl::Appender::File
45
	  log4perl.appender.Main.filename = $LOG_PATH
46
	  log4perl.appender.Main.mode=append
47
	  log4perl.appender.Main.layout = Log::Log4perl::Layout::PatternLayout
48
	  log4perl.appender.Main.layout.ConversionPattern=[%d] %p - %M - %m - %l%n
49
END
50
        Log::Log4perl->init( \$config );
51
    }
52
    my $log = Log::Log4perl->get_logger('Main');
53
    $log->level( $params->{level} )
54
      if defined $params->{level};    # change level if we have passed one
55
    #bless $log, $proto;
56
    return $log;
52
}
57
}
53
58
54
sub _write {
59
sub _write {
Lines 56-62 sub _write { Link Here
56
61
57
    if ( not $self->{LOGGER} ) {
62
    if ( not $self->{LOGGER} ) {
58
        if ( $log_level <= $self->{LEVEL} ) {
63
        if ( $log_level <= $self->{LEVEL} ) {
59
            print STDERR "[" . localtime() . "] " . "$LEVEL_STR->{$log_level}: " . $msg . ( $cb ? " (" . $cb . ")" : "" ) . "\n";
64
            print STDERR "["
65
              . localtime() . "] "
66
              . "$LEVEL_STR->{$log_level}: "
67
              . $msg
68
              . ( $cb ? " (" . $cb . ")" : "" ) . "\n";
60
        }
69
        }
61
        return;
70
        return;
62
    }
71
    }
Lines 68-128 sub _write { Link Here
68
    $self->{LOGGER}->write( $msg, $log_level );
77
    $self->{LOGGER}->write( $msg, $log_level );
69
78
70
    if ( $log_level <= $self->{LEVEL} ) {
79
    if ( $log_level <= $self->{LEVEL} ) {
71
        my $message = "[" . localtime() . "] " . "$LEVEL_STR->{$log_level}: " . $msg . ( $cb ? " (" . $cb . ")" : "" ) . "\n";
80
        my $message = "["
81
          . localtime() . "] "
82
          . "$LEVEL_STR->{$log_level}: "
83
          . $msg
84
          . ( $cb ? " (" . $cb . ")" : "" ) . "\n";
72
        push( @{ $self->{LOGGED_MESSAGES} }, $message );
85
        push( @{ $self->{LOGGED_MESSAGES} }, $message );
73
    }
86
    }
74
}
87
}
75
88
76
sub unusable {
89
#sub unusable {
77
    my ( $self, $msg, $dump ) = @_;
90
#    my ( $self, $msg, $dump ) = @_;
78
    my $cb = $self->_called_by();
91
#    my $cb = $self->_called_by();
79
    $self->_write( $msg, $UNUSABLE_LOG_LEVEL, $dump, $cb );
92
#    $self->_write( $msg, $UNUSABLE_LOG_LEVEL, $dump, $cb );
80
}
93
#}
81
94
82
sub critical {
95
#sub critical {
83
    my ( $self, $msg, $dump ) = @_;
96
#    my ( $self, $msg, $dump ) = @_;
84
    my $cb = $self->_called_by();
97
#    my $cb = $self->_called_by();
85
    $self->_write( $msg, $CRITICAL_LOG_LEVEL, $dump, $cb );
98
#    $self->_write( $msg, $CRITICAL_LOG_LEVEL, $dump, $cb );
86
}
99
#}
87
100
88
sub error {
101
# sub error {
89
    my ( $self, $msg, $dump ) = @_;
102
 #   my ( $self, $msg, $dump ) = @_;
90
    my $cb = $self->_called_by();
103
#    my $cb = $self->_called_by();
91
    $self->_write( $msg, $ERROR_LOG_LEVEL, $dump, $cb );
104
#    $self->_write( $msg, $ERROR_LOG_LEVEL, $dump, $cb );
92
}
105
    
93
106
#}
94
sub warning {
107
95
    my ( $self, $msg, $dump ) = @_;
108
#sub warning {
96
    my $cb = $self->_called_by();
109
#    my ( $self, $msg, $dump ) = @_;
97
    $self->_write( $msg, $WARNING_LOG_LEVEL, $dump, $cb );
110
#    my $cb = $self->_called_by();
98
}
111
#    $self->_write( $msg, $WARNING_LOG_LEVEL, $dump, $cb );
99
112
#}
100
sub log {
113
101
    my ( $self, $msg, $dump ) = @_;
114
#sub log {
102
    $self->_write( $msg, $NORMAL_LOG_LEVEL, $dump );
115
#    my ( $self, $msg, $dump ) = @_;
103
}
116
#    $self->_write( $msg, $NORMAL_LOG_LEVEL, $dump );
104
117
#}
105
sub normal {
118
106
    my ( $self, $msg, $dump ) = @_;
119
#sub normal {
107
    $self->_write( $msg, $NORMAL_LOG_LEVEL, $dump );
120
#    my ( $self, $msg, $dump ) = @_;
108
}
121
#    $self->_write( $msg, $NORMAL_LOG_LEVEL, $dump );
109
122
#}
110
sub info {
123
111
    my ( $self, $msg, $dump ) = @_;
124
#sub info {
112
    $self->_write( $msg, $INFO_LOG_LEVEL, $dump );
125
#    my ( $self, $msg, $dump ) = @_;
113
}
126
#    $self->_write( $msg, $INFO_LOG_LEVEL, $dump );
114
127
#}
115
sub debug {
128
116
    my ( $self, $msg, $dump ) = @_;
129
#sub debug {
117
    $self->_write( $msg, $DEBUG_LOG_LEVEL, $dump );
130
#    my ( $self, $msg, $dump ) = @_;
118
}
131
#    $self->_write( $msg, $DEBUG_LOG_LEVEL, $dump );
132
#}
119
133
120
sub level {
134
sub level {
135
die "not calling right thing";
136
    warn "YO";
121
    my $self = shift;
137
    my $self = shift;
122
138
    my $level = shift;
123
    return $self->{LOGGER}
139
    if ($level){
124
      ? $self->{LOGGER}->level(@_)
140
        $self->level( $LEVEL_STR->{ @_ } );
125
      : ( $self->{LEVEL} = @_ ? shift : $self->{LEVEL} );
141
        return $level;
142
    }
143
    else {
144
        return 1; #return the level here
145
    }
126
}
146
}
127
147
128
sub _called_by {
148
sub _called_by {
Lines 143-149 sub _called_by { Link Here
143
    my $str = "";
163
    my $str = "";
144
164
145
    while (1) {
165
    while (1) {
146
        ( $pack, $file, $line, $subr, $has_args, $wantarray, $evaltext, $is_require, $hints, $bitmask ) = caller($depth);
166
        (
167
            $pack,      $file,     $line,       $subr,  $has_args,
168
            $wantarray, $evaltext, $is_require, $hints, $bitmask
169
        ) = caller($depth);
147
        unless ( defined($subr) ) {
170
        unless ( defined($subr) ) {
148
            last;
171
            last;
149
        }
172
        }
(-)a/t/Logger.t (-7 / +6 lines)
Lines 16-22 use_ok('Koha::Utils::Logger'); Link Here
16
isnt(C4::Context->preference("LogLevel"), undef, "Check LogLevel syspref");
16
isnt(C4::Context->preference("LogLevel"), undef, "Check LogLevel syspref");
17
use Koha::Utils::Logger qw/$log/;
17
use Koha::Utils::Logger qw/$log/;
18
is($log, undef, "Check \$log is undef");
18
is($log, undef, "Check \$log is undef");
19
$log = Koha::Utils::Logger->new({level => 3});
19
$log = Koha::Utils::Logger->new({level => 'ERROR' });
20
isnt($log, undef, "Check \$log is not undef");
20
isnt($log, undef, "Check \$log is not undef");
21
21
22
22
Lines 24-33 my @lines = (); Link Here
24
$log->error( "an error string");
24
$log->error( "an error string");
25
$log->normal( "a normal string");
25
$log->normal( "a normal string");
26
@lines = get_contains( $logfile );
26
@lines = get_contains( $logfile );
27
is(grep (/an error string/, @lines), 1, "check error string with level 3");
27
is(grep (/an error string/, @lines), 1, "check error string with level ERROR");
28
is(grep (/a normal string/, @lines), 0, "check normal string with level 3");
28
is(grep (/a normal string/, @lines), 0, "check normal string with level ERROR");
29
truncate_file($logfile);
29
truncate_file($logfile);
30
$log->level(5);
30
$log->level('NORMAL');
31
$log->error( "an error string");
31
$log->error( "an error string");
32
$log->normal( "a normal string");
32
$log->normal( "a normal string");
33
test_calledby( "test calledby" );
33
test_calledby( "test calledby" );
Lines 36-44 my $struct = { Link Here
36
    b => "bbbbb",
36
    b => "bbbbb",
37
    c => "ccccc"
37
    c => "ccccc"
38
};
38
};
39
$log->warning($struct, 1);
39
$log->warn($struct, 1);
40
@lines = get_contains( $logfile );
40
@lines = get_contains( $logfile );
41
is(grep (/an error string/, @lines), 1, "check error string with level 5");
41
is(grep (/an error string/, @lines), 1, "check error string with level NORMAL");
42
is(grep (/a normal string/, @lines), 1, "check normal string with level 5");
42
is(grep (/a normal string/, @lines), 1, "check normal string with level 5");
43
is(grep (/test_calledby/, @lines), 1, "check calledby string with level 5");
43
is(grep (/test_calledby/, @lines), 1, "check calledby string with level 5");
44
is(grep (/WARN/, @lines), 1, "check WARN string with dump");
44
is(grep (/WARN/, @lines), 1, "check WARN string with dump");
45
- 

Return to bug 8190