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 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 1189-1194 sub tz { Link Here
1189
    return $context->{tz};
1191
    return $context->{tz};
1190
}
1192
}
1191
1193
1194
=head2 logger
1195
1196
  $logger = C4::Context->logger;
1197
1198
Returns a Koha logger. If no logger has yet been instantiated,
1199
this method creates one, and caches it.
1200
1201
=cut
1202
1203
sub logger
1204
{
1205
    my $self = shift;
1206
    my $sth;
1207
1208
    if ( defined( $context->{"logger"} ) ) {
1209
	return $context->{"logger"};
1210
    }
1211
1212
    $context->{"logger"} = Koha::Utils::Logger->new(
1213
        {
1214
            level => C4::Context->preference("LogLevel")
1215
        }
1216
    );
1217
1218
    return $context->{"logger"};
1219
}
1192
1220
1193
1221
1194
1;
1222
1;
(-)a/C4/Installer/PerlDependencies.pm (-1 / +6 lines)
Lines 628-639 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' => '0',
634
        'required' => '0',
635
        'min_ver'  => '0.22',
635
        'min_ver'  => '0.22',
636
    },
636
    },
637
    'Log::LogLite' => {
638
        usage    => 'Core',
639
        required => '1',
640
        min_ver  => '0.82',
641
    },
637
};
642
};
638
643
639
1;
644
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 406-408 INSERT INTO systempreferences (variable,value,explanation,options,type) VALUES(' Link Here
406
INSERT INTO systempreferences (variable,value,explanation,options,type) VALUES('NotesBlacklist','','List of notes fields that should not appear in the title notes/description separator of details',NULL,'free');
406
INSERT INTO systempreferences (variable,value,explanation,options,type) VALUES('NotesBlacklist','','List of notes fields that should not appear in the title notes/description separator of details',NULL,'free');
407
INSERT INTO systempreferences (variable,value,options,explanation,type) VALUES ('SCOUserCSS', '', NULL, 'Add CSS to be included in the SCO module in an embedded <style> tag.', 'free');
407
INSERT INTO systempreferences (variable,value,options,explanation,type) VALUES ('SCOUserCSS', '', NULL, 'Add CSS to be included in the SCO module in an embedded <style> tag.', 'free');
408
INSERT INTO systempreferences (variable,value,options,explanation,type) VALUES ('SCOUserJS', '', NULL, 'Define custom javascript for inclusion in the SCO module', 'free');
408
INSERT INTO systempreferences (variable,value,options,explanation,type) VALUES ('SCOUserJS', '', NULL, 'Define custom javascript for inclusion in the SCO module', 'free');
409
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');
410
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 6339-6344 if ( CheckVersion($DBversion) ) { Link Here
6339
   SetVersion ($DBversion);
6338
   SetVersion ($DBversion);
6340
}
6339
}
6341
6340
6341
$DBversion = "3.11.00.XXX";
6342
if ( C4::Context->preference("Version") < TransformToNum($DBversion) ) {
6343
    $dbh->do(qq{
6344
        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');
6345
    });
6346
    $dbh->do(qq{
6347
        INSERT IGNORE INTO systempreferences (variable,value,explanation,options,type) VALUES ('LogToHtmlComments','0','Embed the logs into the html as a comment.','','YesNo');
6348
    });
6349
    print "Upgrade to $DBversion done (Add system preferences LogLevel, LogToHtmlComments)\n";
6350
    SetVersion($DBversion);
6351
}
6352
6342
=head1 FUNCTIONS
6353
=head1 FUNCTIONS
6343
6354
6344
=head2 TableExists($table)
6355
=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