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

(-)a/C4/Auth.pm (+3 lines)
Lines 364-369 sub get_template_and_user { Link Here
364
            OPACLocalCoverImages        => C4::Context->preference('OPACLocalCoverImages'),
364
            OPACLocalCoverImages        => C4::Context->preference('OPACLocalCoverImages'),
365
            AllowMultipleCovers         => C4::Context->preference('AllowMultipleCovers'),
365
            AllowMultipleCovers         => C4::Context->preference('AllowMultipleCovers'),
366
            EnableBorrowerFiles         => C4::Context->preference('EnableBorrowerFiles'),
366
            EnableBorrowerFiles         => C4::Context->preference('EnableBorrowerFiles'),
367
            LogToHtmlComments           => C4::Context->preference('LogToHtmlComments'),
368
            Logger                      => C4::Context->logger(),
367
        );
369
        );
368
    }
370
    }
369
    else {
371
    else {
Lines 466-471 sub get_template_and_user { Link Here
466
468
467
        $template->param(OpacPublic => '1') if ($user || C4::Context->preference("OpacPublic"));
469
        $template->param(OpacPublic => '1') if ($user || C4::Context->preference("OpacPublic"));
468
    }
470
    }
471
469
    return ( $template, $borrowernumber, $cookie, $flags);
472
    return ( $template, $borrowernumber, $cookie, $flags);
470
}
473
}
471
474
(-)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 1177-1182 sub tz { Link Here
1177
    return $context->{tz};
1179
    return $context->{tz};
1178
}
1180
}
1179
1181
1182
=head2 logger
1183
1184
  $logger = C4::Context->logger;
1185
1186
Returns a Koha logger. If no logger has yet been instantiated,
1187
this method creates one, and caches it.
1188
1189
=cut
1190
1191
sub logger
1192
{
1193
    my $self = shift;
1194
    my $sth;
1195
1196
    if ( defined( $context->{"logger"} ) ) {
1197
	return $context->{"logger"};
1198
    }
1199
1200
    $context->{"logger"} = Koha::Utils::Logger->new(
1201
        {
1202
            level => C4::Context->preference("LogLevel")
1203
        }
1204
    );
1205
1206
    return $context->{"logger"};
1207
}
1180
1208
1181
1209
1182
1;
1210
1;
(-)a/C4/Installer/PerlDependencies.pm (+5 lines)
Lines 629-634 our $PERL_DEPS = { Link Here
629
        'required' => '0',
629
        'required' => '0',
630
        'min_ver'  => '1.09',
630
        'min_ver'  => '1.09',
631
      },
631
      },
632
    'Log::LogLite' => {
633
        usage    => 'Core',
634
        required => '1',
635
        min_ver  => '0.82',
636
    },
632
};
637
};
633
638
634
1;
639
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 64-69 liblist-moreutils-perl install Link Here
64
liblocale-currency-format-perl install
64
liblocale-currency-format-perl install
65
liblocale-gettext-perl	install
65
liblocale-gettext-perl	install
66
liblocale-po-perl	install
66
liblocale-po-perl	install
67
liblog-loglite-perl install
67
libmail-sendmail-perl install
68
libmail-sendmail-perl install
68
libmarc-charset-perl install
69
libmarc-charset-perl install
69
libmarc-crosswalk-dublincore-perl install
70
libmarc-crosswalk-dublincore-perl install
(-)a/installer/data/mysql/sysprefs.sql (+2 lines)
Lines 388-390 INSERT INTO systempreferences (variable, value, options, explanation, type) VALU Link Here
388
INSERT INTO systempreferences (variable,value,explanation,options,type) VALUES('HoldsToPullStartDate','2','Set the default start date for the Holds to pull list to this many days ago',NULL,'Integer');
388
INSERT INTO systempreferences (variable,value,explanation,options,type) VALUES('HoldsToPullStartDate','2','Set the default start date for the Holds to pull list to this many days ago',NULL,'Integer');
389
INSERT INTO systempreferences (variable,value,explanation,options,type) VALUES('alphabet','A B C D E F G H I J K L M N O P Q R S T U V W X Y Z','Alphabet than can be expanded into browse links, e.g. on Home > Patrons',NULL,'free');
389
INSERT INTO systempreferences (variable,value,explanation,options,type) VALUES('alphabet','A B C D E F G H I J K L M N O P Q R S T U V W X Y Z','Alphabet than can be expanded into browse links, e.g. on Home > Patrons',NULL,'free');
390
INSERT INTO systempreferences (variable,value,explanation,options,type) VALUES('RefundLostItemFeeOnReturn', '1', 'If enabled, the lost item fee charged to a borrower will be refunded when the lost item is returned.', NULL, 'YesNo');
390
INSERT INTO systempreferences (variable,value,explanation,options,type) VALUES('RefundLostItemFeeOnReturn', '1', 'If enabled, the lost item fee charged to a borrower will be refunded when the lost item is returned.', NULL, 'YesNo');
391
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');
392
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 / +12 lines)
Lines 5786-5792 $DBversion = "3.09.00.045"; Link Here
5786
if ( C4::Context->preference("Version") < TransformToNum($DBversion) ) {
5786
if ( C4::Context->preference("Version") < TransformToNum($DBversion) ) {
5787
    $dbh->do("ALTER TABLE borrower_attribute_types MODIFY category_code VARCHAR( 10 ) NULL DEFAULT NULL");
5787
    $dbh->do("ALTER TABLE borrower_attribute_types MODIFY category_code VARCHAR( 10 ) NULL DEFAULT NULL");
5788
    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
    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.";
5789
    SetVersion($DBversion);
5790
}
5789
}
5791
5790
5792
$DBversion = "3.09.00.046";
5791
$DBversion = "3.09.00.046";
Lines 6134-6139 if (C4::Context->preference("Version") < TransformToNum($DBversion)) { Link Here
6134
    SetVersion ($DBversion);
6133
    SetVersion ($DBversion);
6135
}
6134
}
6136
6135
6136
$DBversion = "3.11.00.XXX";
6137
if ( C4::Context->preference("Version") < TransformToNum($DBversion) ) {
6138
    $dbh->do(qq{
6139
        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');
6140
    });
6141
    $dbh->do(qq{
6142
        INSERT IGNORE INTO systempreferences (variable,value,explanation,options,type) VALUES ('LogToHtmlComments','0','Embed the logs into the html as a comment.','','YesNo');
6143
    });
6144
    print "Upgrade to $DBversion done (Add system preferences LogLevel, LogToHtmlComments)\n";
6145
    SetVersion($DBversion);
6146
}
6147
6137
=head1 FUNCTIONS
6148
=head1 FUNCTIONS
6138
6149
6139
=head2 TableExists($table)
6150
=head2 TableExists($table)
(-)a/koha-tmpl/intranet-tmpl/prog/en/includes/doc-head-open.inc (+5 lines)
Lines 2-4 Link Here
2
    "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
2
    "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
3
[% IF ( bidi ) %]<html lang="[% lang %]" xml:lang="[% lang %]" dir="[% bidi %]" xmlns="http://www.w3.org/1999/xhtml">[% ELSE %]<html lang="[% lang %]" xml:lang="[% lang %]" xmlns="http://www.w3.org/1999/xhtml">[% END %]
3
[% IF ( bidi ) %]<html lang="[% lang %]" xml:lang="[% lang %]" dir="[% bidi %]" xmlns="http://www.w3.org/1999/xhtml">[% ELSE %]<html lang="[% lang %]" xml:lang="[% lang %]" xmlns="http://www.w3.org/1999/xhtml">[% END %]
4
<head>
4
<head>
5
[%- IF LogToHtmlComments %]
6
<!-- LOG MESSAGES
7
[% FOREACH message IN Logger.get_messages() %][% message %][% END %]
8
-->
9
[% END %]
(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/admin.pref (+20 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
128
        -
129
            - pref: LogToHtmlComments
130
              default: 0
131
              choices:
132
                  yes: Embed
133
                  no: "Don't embed"
134
            - 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 492-497 elsif (C4::Context->preference('NoZebra')) { Link Here
492
    $pasarParams .= '&amp;count=' . $results_per_page;
495
    $pasarParams .= '&amp;count=' . $results_per_page;
493
    $pasarParams .= '&amp;simple_query=' . $simple_query;
496
    $pasarParams .= '&amp;simple_query=' . $simple_query;
494
    $pasarParams .= '&amp;query_type=' . $query_type if ($query_type);
497
    $pasarParams .= '&amp;query_type=' . $query_type if ($query_type);
498
    $log->info("OPAC: Search for $query");
495
    eval {
499
    eval {
496
        ($error, $results_hashref, $facets) = getRecords($query,$simple_query,\@sort_by,\@servers,$results_per_page,$offset,$expanded_facet,$branches,$itemtypes,$query_type,$scan,1);
500
        ($error, $results_hashref, $facets) = getRecords($query,$simple_query,\@sort_by,\@servers,$results_per_page,$offset,$expanded_facet,$branches,$itemtypes,$query_type,$scan,1);
497
    };
501
    };
(-)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