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

(-)a/C4/Installer/PerlDependencies.pm (+5 lines)
Lines 610-615 our $PERL_DEPS = { Link Here
610
        'required' => '1',
610
        'required' => '1',
611
        'min_ver'  => '1.23',
611
        'min_ver'  => '1.23',
612
    },
612
    },
613
    'Log::LogLite' => {
614
        usage    => 'Core',
615
        required => '1',
616
        min_ver  => '0.82',
617
    },
613
};
618
};
614
619
615
1;
620
1;
(-)a/Koha/Utils/Logger.pm (+176 lines)
Line 0 Link Here
1
package Koha::Utils::Logger;
2
3
# Copyright 2012 Biblibre SARL
4
#
5
# This file is part of Koha.
6
#
7
# Koha is free software; you can redistribute it and/or modify it under the
8
# terms of the GNU General Public License as published by the Free Software
9
# Foundation; either version 2 of the License, or (at your option) any later
10
# version.
11
#
12
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
15
#
16
# You should have received a copy of the GNU General Public License along
17
# with Koha; if not, write to the Free Software Foundation, Inc.,
18
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20
use Modern::Perl;
21
use Log::LogLite;
22
23
use base 'Exporter';
24
our @EXPORT_OK = qw($log);
25
26
my $UNUSABLE_LOG_LEVEL = 1;
27
my $CRITICAL_LOG_LEVEL = 2;
28
my $ERROR_LOG_LEVEL    = 3;
29
my $WARNING_LOG_LEVEL  = 4;
30
my $NORMAL_LOG_LEVEL   = 5;
31
my $INFO_LOG_LEVEL     = 6;
32
my $DEBUG_LOG_LEVEL    = 7;
33
34
my $LEVEL_STR = {
35
    $UNUSABLE_LOG_LEVEL => 'UNUS  ',
36
    $CRITICAL_LOG_LEVEL => 'CRIT  ',
37
    $ERROR_LOG_LEVEL    => 'ERROR ',
38
    $WARNING_LOG_LEVEL  => 'WARN  ',
39
    $NORMAL_LOG_LEVEL   => 'NORMAL',
40
    $INFO_LOG_LEVEL     => 'INFO  ',
41
    $DEBUG_LOG_LEVEL    => 'DEBUG ',
42
};
43
44
use Data::Dumper;
45
46
our $log = undef;
47
48
sub new {
49
    my ( $proto, $params ) = @_;
50
51
    return $log if $log and ( not defined $params->{file} or not defined $log->{FILE_PATH} or $params->{file} eq $log->{FILE_PATH} );
52
    my $class = ref($proto) || $proto;
53
    my $self = {};
54
    my $LOG_PATH = defined $ENV{KOHA_LOG} ? $ENV{KOHA_LOG} : undef;
55
    $self->{FILE_PATH} = defined $params->{file}  ? $params->{file}  : $LOG_PATH;
56
    $self->{LEVEL} = defined $params->{level} ? $params->{level} : $INFO_LOG_LEVEL;
57
    if ( not defined $self->{FILE_PATH} ) {
58
        return bless($self, $class);
59
    }
60
    eval {
61
        $self->{LOGGER} = Log::LogLite->new($self->{FILE_PATH}, $self->{LEVEL});
62
    };
63
    die "Log system is not correctly configured ($@)" if $@;
64
    return bless( $self, $class );
65
}
66
67
sub write {
68
    my ($self, $msg, $log_level, $dump, $cb) = @_;
69
70
    if ( not $self->{LOGGER} ) {
71
        if($log_level <= $self->{LEVEL}) {
72
            print STDERR "[" . localtime() . "] "
73
                . "$LEVEL_STR->{$log_level}: "
74
                . $msg
75
                . ( $cb ? " (" . $cb . ")" : "" )
76
                . "\n";
77
        }
78
        return;
79
    }
80
    my $template = "[<date>] $LEVEL_STR->{$log_level}: <message>";
81
    $template .= " (caller: $cb)" if $cb;
82
    $template .= "\n";
83
    $self->{LOGGER}->template($template);
84
    $msg = "\n" . Dumper $msg if $dump;
85
    $self->{LOGGER}->write($msg, $log_level);
86
}
87
88
sub unusable {
89
    my ($self, $msg, $dump) = @_;
90
    my $cb = $self->called_by();
91
    $self->write($msg, $UNUSABLE_LOG_LEVEL, $dump, $cb);
92
}
93
94
sub critical {
95
    my ($self, $msg, $dump) = @_;
96
    my $cb = $self->called_by();
97
    $self->write($msg, $CRITICAL_LOG_LEVEL, $dump, $cb);
98
}
99
100
sub error {
101
    my ($self, $msg, $dump) = @_;
102
    my $cb = $self->called_by();
103
    $self->write($msg, $ERROR_LOG_LEVEL, $dump, $cb);
104
}
105
106
sub warning {
107
    my ($self, $msg, $dump) = @_;
108
    my $cb = $self->called_by();
109
    $self->write($msg, $WARNING_LOG_LEVEL, $dump, $cb);
110
}
111
112
sub log {
113
    my ($self, $msg, $dump) = @_;
114
    $self->write($msg, $NORMAL_LOG_LEVEL, $dump);
115
}
116
117
sub normal {
118
    my ($self, $msg, $dump) = @_;
119
    $self->write($msg, $NORMAL_LOG_LEVEL, $dump);
120
}
121
122
sub info {
123
    my ($self, $msg, $dump) = @_;
124
    $self->write($msg, $INFO_LOG_LEVEL, $dump);
125
}
126
127
sub debug {
128
    my ($self, $msg, $dump) = @_;
129
    $self->write($msg, $DEBUG_LOG_LEVEL, $dump);
130
}
131
132
sub level {
133
    my $self = shift;
134
135
    return $self->{LOGGER}
136
           ? $self->{LOGGER}->level(@_)
137
           : ($self->{LEVEL} = @_ ? shift : $self->{LEVEL});
138
}
139
140
141
sub called_by {
142
    my $self = shift;
143
    my $depth = 2;
144
    my $args;
145
    my $pack;
146
    my $file;
147
    my $line;
148
    my $subr;
149
    my $has_args;
150
    my $wantarray;
151
    my $evaltext;
152
    my $is_require;
153
    my $hints;
154
    my $bitmask;
155
    my @subr;
156
    my $str = "";
157
    while (1) {
158
        ($pack, $file, $line, $subr, $has_args, $wantarray, $evaltext,
159
         $is_require, $hints, $bitmask) = caller($depth);
160
        unless (defined($subr)) {
161
            last;
162
        }
163
        $depth++;
164
        $line = (3) ? "$file:".$line."-->" : "";
165
        push(@subr, $line.$subr);
166
    }
167
    @subr = reverse(@subr);
168
    foreach $subr (@subr) {
169
        $str .= $subr;
170
        $str .= " > ";
171
    }
172
    $str =~ s/ > $/: /;
173
    return $str;
174
} # of called_by
175
176
1;
(-)a/install_misc/debian.packages (+1 lines)
Lines 56-61 liblist-moreutils-perl install Link Here
56
liblocale-currency-format-perl install
56
liblocale-currency-format-perl install
57
liblocale-gettext-perl	install
57
liblocale-gettext-perl	install
58
liblocale-po-perl	install
58
liblocale-po-perl	install
59
liblog-loglite-perl install
59
libmail-sendmail-perl install
60
libmail-sendmail-perl install
60
libmarc-charset-perl install
61
libmarc-charset-perl install
61
libmarc-crosswalk-dublincore-perl install
62
libmarc-crosswalk-dublincore-perl install
(-)a/installer/data/mysql/updatedatabase.pl (+8 lines)
Lines 5785-5790 $DBversion = "3.09.00.045"; Link Here
5785
if ( C4::Context->preference("Version") < TransformToNum($DBversion) ) {
5785
if ( C4::Context->preference("Version") < TransformToNum($DBversion) ) {
5786
    $dbh->do("ALTER TABLE borrower_attribute_types MODIFY category_code VARCHAR( 10 ) NULL DEFAULT NULL");
5786
    $dbh->do("ALTER TABLE borrower_attribute_types MODIFY category_code VARCHAR( 10 ) NULL DEFAULT NULL");
5787
    print "Upgrade to $DBversion done. (Bug 8002: Update patron attribute types table from varchar(1) to varchar(10) category_code)\nWarning to Koha System Administrators: If you use borrower attributes defined by borrower categories, you have to check your configuration. A bug may have removed your attribute links to borrower categories.\nPlease check, and fix it if necessary.";
5787
    print "Upgrade to $DBversion done. (Bug 8002: Update patron attribute types table from varchar(1) to varchar(10) category_code)\nWarning to Koha System Administrators: If you use borrower attributes defined by borrower categories, you have to check your configuration. A bug may have removed your attribute links to borrower categories.\nPlease check, and fix it if necessary.";
5788
}
5789
5790
$DBversion = "3.09.00.XXX";
5791
if ( C4::Context->preference("Version") < TransformToNum($DBversion) ) {
5792
    $dbh->do(qq{
5793
        INSERT IGNORE INTO systempreferences (variable,value,explanation,options,type) VALUES ('LogLevel','5','Set the level of logs. 1=Unusable, 2=Critical, 3=Error, 4=Warning, 5=Normal, 6=Info, 7=Debug','1|2|3|4|5|6|7','Choice');
5794
    });
5795
    print "Upgrade to $DBversion done (Add system preference LogLevel)\n";
5788
    SetVersion($DBversion);
5796
    SetVersion($DBversion);
5789
}
5797
}
5790
5798
(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/admin.pref (+13 lines)
Lines 112-114 Administration: Link Here
112
                Solr: Solr
112
                Solr: Solr
113
                Zebra: Zebra
113
                Zebra: Zebra
114
            - is the search engine used.
114
            - is the search engine used.
115
    Logger:
116
        -
117
            - Set the level
118
            - pref: LogLevel
119
              choices:
120
                1: 1- Unusable
121
                2: 2- Critical
122
                3: 3- Error
123
                4: 4- Warning
124
                5: 5- Normal
125
                6: 6- Info
126
                7: 7- Debug
127
            - for logs
(-)a/opac/opac-search.pl (+4 lines)
Lines 51-62 use C4::Tags qw(get_tags); Link Here
51
use C4::Branch; # GetBranches
51
use C4::Branch; # GetBranches
52
use C4::SocialData;
52
use C4::SocialData;
53
use C4::Ratings;
53
use C4::Ratings;
54
use Koha::Utils::Logger qw/$log/;
54
55
55
use POSIX qw(ceil floor strftime);
56
use POSIX qw(ceil floor strftime);
56
use URI::Escape;
57
use URI::Escape;
57
use Storable qw(thaw freeze);
58
use Storable qw(thaw freeze);
58
use Business::ISBN;
59
use Business::ISBN;
59
60
61
$log = Koha::Utils::Logger->new({level => C4::Context->preference("LogLevel")});
62
60
my $DisplayMultiPlaceHold = C4::Context->preference("DisplayMultiPlaceHold");
63
my $DisplayMultiPlaceHold = C4::Context->preference("DisplayMultiPlaceHold");
61
# create a new CGI object
64
# create a new CGI object
62
# FIXME: no_undef_params needs to be tested
65
# FIXME: no_undef_params needs to be tested
Lines 498-503 elsif (C4::Context->preference('NoZebra')) { Link Here
498
    $pasarParams .= '&amp;count=' . $results_per_page;
501
    $pasarParams .= '&amp;count=' . $results_per_page;
499
    $pasarParams .= '&amp;simple_query=' . $simple_query;
502
    $pasarParams .= '&amp;simple_query=' . $simple_query;
500
    $pasarParams .= '&amp;query_type=' . $query_type if ($query_type);
503
    $pasarParams .= '&amp;query_type=' . $query_type if ($query_type);
504
    $log->info("OPAC: Search for $query");
501
    eval {
505
    eval {
502
        ($error, $results_hashref, $facets) = getRecords($query,$simple_query,\@sort_by,\@servers,$results_per_page,$offset,$expanded_facet,$branches,$itemtypes,$query_type,$scan);
506
        ($error, $results_hashref, $facets) = getRecords($query,$simple_query,\@sort_by,\@servers,$results_per_page,$offset,$expanded_facet,$branches,$itemtypes,$query_type,$scan);
503
    };
507
    };
(-)a/t/Logger.t (-1 / +95 lines)
Line 0 Link Here
0
- 
1
#!/usr/bin/perl
2
3
use utf8;
4
use Modern::Perl;
5
if ( not $ENV{KOHA_LOG} ) {
6
    usage();
7
    exit;
8
}
9
10
use Test::More;
11
require C4::Context;
12
import C4::Context;
13
plan tests => 15;
14
15
my $logfile = $ENV{KOHA_LOG};
16
17
use_ok('Koha::Utils::Logger');
18
isnt(C4::Context->preference("LogLevel"), undef, "Check LogLevel syspref");
19
use Koha::Utils::Logger qw/$log/;
20
is($log, undef, "Check \$log is undef");
21
$log = Koha::Utils::Logger->new({level => 3});
22
isnt($log, undef, "Check \$log is not undef");
23
24
25
my @lines = ();
26
$log->error( "an error string");
27
$log->normal( "a normal string");
28
@lines = get_contains( $logfile );
29
is(grep (/an error string/, @lines), 1, "check error string with level 3");
30
is(grep (/a normal string/, @lines), 0, "check normal string with level 3");
31
truncate_file($logfile);
32
$log->level(5);
33
$log->error( "an error string");
34
$log->normal( "a normal string");
35
test_calledby( "test calledby" );
36
my $struct = {
37
    a => "aaaaa",
38
    b => "bbbbb",
39
    c => "ccccc"
40
};
41
$log->warning($struct, 1);
42
@lines = get_contains( $logfile );
43
is(grep (/an error string/, @lines), 1, "check error string with level 5");
44
is(grep (/a normal string/, @lines), 1, "check normal string with level 5");
45
is(grep (/test_calledby/, @lines), 1, "check calledby string with level 5");
46
is(grep (/WARN/, @lines), 1, "check WARN string with dump");
47
is(grep (/VAR1/, @lines), 1, "check VAR1 string with dump");
48
is(grep (/aaaaa/, @lines), 1, "check values aaaaa string with dump");
49
is(5, $log->level, "check log level return");
50
51
52
$ENV{KOHA_LOG} = undef;
53
my $log_stderr_file = qq{/tmp/stderr.log};
54
$log = undef;
55
$log = Koha::Utils::Logger->new({level => 3});
56
open(STDERR, ">>$log_stderr_file");
57
$log->error( "an error string");
58
$log->normal( "a normal string");
59
@lines = get_contains( $log_stderr_file );
60
is(grep (/an error string/, @lines), 1, "check error string with level 3");
61
is(grep (/a normal string/, @lines), 0, "check normal string with level 3");
62
63
system( qq{rm $logfile} );
64
system( qq{rm $log_stderr_file} );
65
66
sub get_contains {
67
    my $filepath = shift;
68
    my @lines;
69
    open FILE, "<", $filepath or die "Can't open $filepath: $!";
70
    while(<FILE>) {
71
        chomp;
72
        push(@lines, $_);
73
    }
74
    close(FILE);
75
    return @lines;
76
}
77
78
sub truncate_file {
79
    my $filepath = shift;
80
    open FILE, ">", $filepath or die "Can't open $filepath: $!";
81
    truncate FILE, 0;
82
    close FILE;
83
}
84
85
sub test_calledby {
86
    my $msg = shift;
87
    $log->error($msg);
88
}
89
90
sub usage {
91
    warn "\n\n+=======================================================+\n";
92
    warn   qq{| You must call this test with a KOHA_LOG env var like: |\n};
93
    warn   qq{| KOHA_LOG="/tmp/t1.log" prove t/Logguer.t              |\n};
94
    warn     "+=======================================================+\n\n";
95
}

Return to bug 8190