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

(-)a/C4/Auth.pm (+3 lines)
Lines 361-366 sub get_template_and_user { Link Here
361
            AllowMultipleCovers         => C4::Context->preference('AllowMultipleCovers'),
361
            AllowMultipleCovers         => C4::Context->preference('AllowMultipleCovers'),
362
            EnableBorrowerFiles         => C4::Context->preference('EnableBorrowerFiles'),
362
            EnableBorrowerFiles         => C4::Context->preference('EnableBorrowerFiles'),
363
            UseKohaPlugins              => C4::Context->preference('UseKohaPlugins'),
363
            UseKohaPlugins              => C4::Context->preference('UseKohaPlugins'),
364
            LogToHtmlComments           => C4::Context->preference('LogToHtmlComments'),
365
            Logger                      => C4::Context->logger(),
364
        );
366
        );
365
    }
367
    }
366
    else {
368
    else {
Lines 468-473 sub get_template_and_user { Link Here
468
470
469
        $template->param(OpacPublic => '1') if ($user || C4::Context->preference("OpacPublic"));
471
        $template->param(OpacPublic => '1') if ($user || C4::Context->preference("OpacPublic"));
470
    }
472
    }
473
471
    return ( $template, $borrowernumber, $cookie, $flags);
474
    return ( $template, $borrowernumber, $cookie, $flags);
472
}
475
}
473
476
(-)a/C4/Context.pm (+28 lines)
Lines 20-25 use strict; Link Here
20
use warnings;
20
use warnings;
21
use vars qw($VERSION $AUTOLOAD $context @context_stack $servers $memcached $ismemcached);
21
use vars qw($VERSION $AUTOLOAD $context @context_stack $servers $memcached $ismemcached);
22
22
23
use Koha::Utils::Logger;
24
23
BEGIN {
25
BEGIN {
24
	if ($ENV{'HTTP_USER_AGENT'})	{
26
	if ($ENV{'HTTP_USER_AGENT'})	{
25
		require CGI::Carp;
27
		require CGI::Carp;
Lines 1227-1232 sub tz { Link Here
1227
    return $context->{tz};
1229
    return $context->{tz};
1228
}
1230
}
1229
1231
1232
=head2 logger
1233
1234
  $logger = C4::Context->logger;
1235
1236
Returns a Koha logger. If no logger has yet been instantiated,
1237
this method creates one, and caches it.
1238
1239
=cut
1240
1241
sub logger
1242
{
1243
    my $self = shift;
1244
    my $sth;
1245
1246
    if ( defined( $context->{"logger"} ) ) {
1247
    return $context->{"logger"};
1248
    }
1249
1250
    $context->{"logger"} = Koha::Utils::Logger->new(
1251
        {
1252
            level => C4::Context->preference("LogLevel")
1253
        }
1254
    );
1255
1256
    return $context->{"logger"};
1257
}
1230
1258
1231
1259
1232
1;
1260
1;
(-)a/C4/Installer/PerlDependencies.pm (-1 / +6 lines)
Lines 628-634 our $PERL_DEPS = { Link Here
628
        'usage'    => 'Core',
628
        'usage'    => 'Core',
629
        'required' => '0',
629
        'required' => '0',
630
        'min_ver'  => '1.09',
630
        'min_ver'  => '1.09',
631
      },
631
    },
632
    'String::Random' => {
632
    'String::Random' => {
633
        'usage'    => 'OpacSelfRegistration',
633
        'usage'    => 'OpacSelfRegistration',
634
        'required' => '1',
634
        'required' => '1',
Lines 689-694 our $PERL_DEPS = { Link Here
689
        'required' => '1',
689
        'required' => '1',
690
        'min_ver'  => '0.22',
690
        'min_ver'  => '0.22',
691
    },
691
    },
692
    'Log::LogLite' => {
693
        usage    => 'Core',
694
        required => '1',
695
        min_ver  => '0.82',
696
    },
692
};
697
};
693
698
694
1;
699
1;
(-)a/Koha/Utils/Logger.pm (+186 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
52
      if $log
53
          and (  not defined $params->{file}
54
              or not defined $log->{FILE_PATH}
55
              or $params->{file} eq $log->{FILE_PATH} );
56
    my $class    = ref($proto) || $proto;
57
    my $self     = {};
58
    my $LOG_PATH = defined $ENV{KOHA_LOG} ? $ENV{KOHA_LOG} : undef;
59
    $self->{FILE_PATH} = defined $params->{file}  ? $params->{file}  : $LOG_PATH;
60
    $self->{LEVEL}     = defined $params->{level} ? $params->{level} : $INFO_LOG_LEVEL;
61
    $self->{LOGGED_MESSAGES} = [];
62
63
    if ( not defined $self->{FILE_PATH} ) {
64
        return bless( $self, $class );
65
    }
66
    eval { $self->{LOGGER} = Log::LogLite->new( $self->{FILE_PATH}, $self->{LEVEL} ); };
67
    die "Log system is not correctly configured ($@)" if $@;
68
    return bless( $self, $class );
69
}
70
71
sub write {
72
    my ( $self, $msg, $log_level, $dump, $cb ) = @_;
73
74
    if ( not $self->{LOGGER} ) {
75
        if ( $log_level <= $self->{LEVEL} ) {
76
            print STDERR "[" . localtime() . "] " . "$LEVEL_STR->{$log_level}: " . $msg . ( $cb ? " (" . $cb . ")" : "" ) . "\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
    if ( $log_level <= $self->{LEVEL} ) {
88
        my $message = "[" . localtime() . "] " . "$LEVEL_STR->{$log_level}: " . $msg . ( $cb ? " (" . $cb . ")" : "" ) . "\n";
89
        push( @{ $self->{LOGGED_MESSAGES} }, $message );
90
    }
91
}
92
93
sub unusable {
94
    my ( $self, $msg, $dump ) = @_;
95
    my $cb = $self->called_by();
96
    $self->write( $msg, $UNUSABLE_LOG_LEVEL, $dump, $cb );
97
}
98
99
sub critical {
100
    my ( $self, $msg, $dump ) = @_;
101
    my $cb = $self->called_by();
102
    $self->write( $msg, $CRITICAL_LOG_LEVEL, $dump, $cb );
103
}
104
105
sub error {
106
    my ( $self, $msg, $dump ) = @_;
107
    my $cb = $self->called_by();
108
    $self->write( $msg, $ERROR_LOG_LEVEL, $dump, $cb );
109
}
110
111
sub warning {
112
    my ( $self, $msg, $dump ) = @_;
113
    my $cb = $self->called_by();
114
    $self->write( $msg, $WARNING_LOG_LEVEL, $dump, $cb );
115
}
116
117
sub log {
118
    my ( $self, $msg, $dump ) = @_;
119
    $self->write( $msg, $NORMAL_LOG_LEVEL, $dump );
120
}
121
122
sub normal {
123
    my ( $self, $msg, $dump ) = @_;
124
    $self->write( $msg, $NORMAL_LOG_LEVEL, $dump );
125
}
126
127
sub info {
128
    my ( $self, $msg, $dump ) = @_;
129
    $self->write( $msg, $INFO_LOG_LEVEL, $dump );
130
}
131
132
sub debug {
133
    my ( $self, $msg, $dump ) = @_;
134
    $self->write( $msg, $DEBUG_LOG_LEVEL, $dump );
135
}
136
137
sub level {
138
    my $self = shift;
139
140
    return $self->{LOGGER}
141
      ? $self->{LOGGER}->level(@_)
142
      : ( $self->{LEVEL} = @_ ? shift : $self->{LEVEL} );
143
}
144
145
sub called_by {
146
    my $self  = shift;
147
    my $depth = 2;
148
    my $args;
149
    my $pack;
150
    my $file;
151
    my $line;
152
    my $subr;
153
    my $has_args;
154
    my $wantarray;
155
    my $evaltext;
156
    my $is_require;
157
    my $hints;
158
    my $bitmask;
159
    my @subr;
160
    my $str = "";
161
162
    while (1) {
163
        ( $pack, $file, $line, $subr, $has_args, $wantarray, $evaltext, $is_require, $hints, $bitmask ) = caller($depth);
164
        unless ( defined($subr) ) {
165
            last;
166
        }
167
        $depth++;
168
        $line = (3) ? "$file:" . $line . "-->" : "";
169
        push( @subr, $line . $subr );
170
    }
171
    @subr = reverse(@subr);
172
    foreach my $sr (@subr) {
173
        $str .= $sr;
174
        $str .= " > ";
175
    }
176
    $str =~ s/ > $/: /;
177
    return $str;
178
}    # of called_by
179
180
sub get_messages {
181
    my $self = shift;
182
183
    return $self->{LOGGED_MESSAGES};
184
}
185
186
1;
(-)a/install_misc/debian.packages (+1 lines)
Lines 71-76 liblist-moreutils-perl install Link Here
71
liblocale-currency-format-perl install
71
liblocale-currency-format-perl install
72
liblocale-gettext-perl	install
72
liblocale-gettext-perl	install
73
liblocale-po-perl	install
73
liblocale-po-perl	install
74
liblog-loglite-perl install
74
libmail-sendmail-perl install
75
libmail-sendmail-perl install
75
libmarc-charset-perl install
76
libmarc-charset-perl install
76
libmarc-crosswalk-dublincore-perl install
77
libmarc-crosswalk-dublincore-perl install
(-)a/installer/data/mysql/sysprefs.sql (+2 lines)
Lines 427-429 INSERT INTO systempreferences (variable,value,explanation,options,type) VALUES(' Link Here
427
INSERT IGNORE INTO systempreferences (variable,value,explanation,options,type) VALUES('UseCourseReserves', '0', 'Enable the course reserves feature.', NULL, 'YesNo');
427
INSERT IGNORE INTO systempreferences (variable,value,explanation,options,type) VALUES('UseCourseReserves', '0', 'Enable the course reserves feature.', NULL, 'YesNo');
428
INSERT IGNORE INTO systempreferences (variable,value,explanation,options,type) VALUES('OpacHoldNotes',0,'Show hold notes on OPAC','','YesNo');
428
INSERT IGNORE INTO systempreferences (variable,value,explanation,options,type) VALUES('OpacHoldNotes',0,'Show hold notes on OPAC','','YesNo');
429
INSERT INTO systempreferences (variable,value,explanation,options,type) VALUES ('CalculateFinesOnReturn','1','Switch to control if overdue fines are calculated on return or not', '', 'YesNo');
429
INSERT INTO systempreferences (variable,value,explanation,options,type) VALUES ('CalculateFinesOnReturn','1','Switch to control if overdue fines are calculated on return or not', '', 'YesNo');
430
INSERT 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');
431
INSERT INTO systempreferences (variable,value,explanation,options,type) VALUES ('LogToHtmlComments','0','Embed the logs into the html as a comment.','','YesNo');
(-)a/installer/data/mysql/updatedatabase.pl (-1 / +13 lines)
Lines 5791-5797 $DBversion = "3.09.00.045"; Link Here
5791
if ( C4::Context->preference("Version") < TransformToNum($DBversion) ) {
5791
if ( C4::Context->preference("Version") < TransformToNum($DBversion) ) {
5792
    $dbh->do("ALTER TABLE borrower_attribute_types MODIFY category_code VARCHAR( 10 ) NULL DEFAULT NULL");
5792
    $dbh->do("ALTER TABLE borrower_attribute_types MODIFY category_code VARCHAR( 10 ) NULL DEFAULT NULL");
5793
    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.";
5793
    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.";
5794
    SetVersion($DBversion);
5795
}
5794
}
5796
5795
5797
$DBversion = "3.09.00.046";
5796
$DBversion = "3.09.00.046";
Lines 6991-6996 if ( CheckVersion($DBversion) ) { Link Here
6991
}
6990
}
6992
6991
6993
6992
6993
$DBversion = "3.13.00.XXX";
6994
if ( CheckVersion($DBversion) ) {
6995
    $dbh->do(qq{
6996
        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');
6997
    });
6998
    $dbh->do(qq{
6999
        INSERT IGNORE INTO systempreferences (variable,value,explanation,options,type) VALUES ('LogToHtmlComments','0','Embed the logs into the html as a comment.','','YesNo');
7000
    });
7001
    print "Upgrade to $DBversion done (Add system preferences LogLevel, LogToHtmlComments)\n";
7002
    SetVersion($DBversion);
7003
}
7004
7005
6994
=head1 FUNCTIONS
7006
=head1 FUNCTIONS
6995
7007
6996
=head2 TableExists($table)
7008
=head2 TableExists($table)
(-)a/koha-tmpl/intranet-tmpl/prog/en/includes/doc-head-open.inc (+5 lines)
Lines 1-3 Link Here
1
<!DOCTYPE html>
1
<!DOCTYPE html>
2
[% IF ( bidi ) %]<html lang="[% lang %]" dir="[% bidi %]">[% ELSE %]<html lang="[% lang %]">[% END %]
2
[% IF ( bidi ) %]<html lang="[% lang %]" dir="[% bidi %]">[% ELSE %]<html lang="[% lang %]">[% END %]
3
<head>
3
<head>
4
[%- IF LogToHtmlComments %]
5
<!-- LOG MESSAGES
6
[% FOREACH message IN Logger.get_messages() %][% message %][% END %]
7
-->
8
[% END %]
(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/admin.pref (+20 lines)
Lines 113-115 Administration: Link Here
113
                Solr: Solr
113
                Solr: Solr
114
                Zebra: Zebra
114
                Zebra: Zebra
115
            - is the search engine used.
115
            - is the search engine used.
116
    Logger:
117
        -
118
            - Set the level
119
            - pref: LogLevel
120
              choices:
121
                1: 1- Unusable
122
                2: 2- Critical
123
                3: 3- Error
124
                4: 4- Warning
125
                5: 5- Normal
126
                6: 6- Info
127
                7: 7- Debug
128
            - for logs
129
        -
130
            - pref: LogToHtmlComments
131
              default: 0
132
              choices:
133
                  yes: Embed
134
                  no: "Don't embed"
135
            - log as a comment in the html.
(-)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 518-523 if ($tag) { Link Here
518
    $pasarParams .= '&amp;count=' . $results_per_page;
521
    $pasarParams .= '&amp;count=' . $results_per_page;
519
    $pasarParams .= '&amp;simple_query=' . $simple_query;
522
    $pasarParams .= '&amp;simple_query=' . $simple_query;
520
    $pasarParams .= '&amp;query_type=' . $query_type if ($query_type);
523
    $pasarParams .= '&amp;query_type=' . $query_type if ($query_type);
524
    $log->info("OPAC: Search for $query");
521
    eval {
525
    eval {
522
        ($error, $results_hashref, $facets) = getRecords($query,$simple_query,\@sort_by,\@servers,$results_per_page,$offset,$expanded_facet,$branches,$itemtypes,$query_type,$scan,1);
526
        ($error, $results_hashref, $facets) = getRecords($query,$simple_query,\@sort_by,\@servers,$results_per_page,$offset,$expanded_facet,$branches,$itemtypes,$query_type,$scan,1);
523
    };
527
    };
(-)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 my $fh, "<", $filepath or die "Can't open $filepath: $!";
70
    while(<$fh>) {
71
        chomp;
72
        push(@lines, $_);
73
    }
74
    close($fh);
75
    return @lines;
76
}
77
78
sub truncate_file {
79
    my $filepath = shift;
80
    open my $fh, ">", $filepath or die "Can't open $filepath: $!";
81
    truncate $fh, 0;
82
    close $fh;
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