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

(-)a/C4/Auth.pm (+2 lines)
Lines 403-408 sub get_template_and_user { Link Here
403
            EnableBorrowerFiles         => C4::Context->preference('EnableBorrowerFiles'),
403
            EnableBorrowerFiles         => C4::Context->preference('EnableBorrowerFiles'),
404
            UseKohaPlugins              => C4::Context->preference('UseKohaPlugins'),
404
            UseKohaPlugins              => C4::Context->preference('UseKohaPlugins'),
405
            UseCourseReserves            => C4::Context->preference("UseCourseReserves"),
405
            UseCourseReserves            => C4::Context->preference("UseCourseReserves"),
406
            LogToHtmlComments           => C4::Context->preference('LogToHtmlComments'),
407
            Logger                      => C4::Context->logger(),
406
        );
408
        );
407
    }
409
    }
408
    else {
410
    else {
(-)a/C4/Context.pm (+29 lines)
Lines 19-24 package C4::Context; Link Here
19
use strict;
19
use strict;
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
23
use Koha::Utils::Logger;
24
22
BEGIN {
25
BEGIN {
23
	if ($ENV{'HTTP_USER_AGENT'})	{
26
	if ($ENV{'HTTP_USER_AGENT'})	{
24
		require CGI::Carp;
27
		require CGI::Carp;
Lines 1221-1226 sub tz { Link Here
1221
    return $context->{tz};
1224
    return $context->{tz};
1222
}
1225
}
1223
1226
1227
=head2 logger
1228
1229
  $logger = C4::Context->logger;
1230
1231
Returns a Koha logger. If no logger has yet been instantiated,
1232
this method creates one, and caches it.
1233
1234
=cut
1235
1236
sub logger
1237
{
1238
    my $self = shift;
1239
    my $sth;
1240
1241
    if ( defined( $context->{"logger"} ) ) {
1242
    return $context->{"logger"};
1243
    }
1244
1245
    $context->{"logger"} = Koha::Utils::Logger->new(
1246
        {
1247
            level => C4::Context->preference("LogLevel")
1248
        }
1249
    );
1250
1251
    return $context->{"logger"};
1252
}
1224
1253
1225
=head2 IsSuperLibrarian
1254
=head2 IsSuperLibrarian
1226
1255
(-)a/C4/Installer/PerlDependencies.pm (+5 lines)
Lines 737-742 our $PERL_DEPS = { Link Here
737
        'required' => '0',
737
        'required' => '0',
738
        'min_ver'  => '5.61',
738
        'min_ver'  => '5.61',
739
    },
739
    },
740
    'Log::LogLite' => {
741
        usage    => 'Core',
742
        required => '1',
743
        min_ver  => '0.82',
744
    },
740
};
745
};
741
746
742
1;
747
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 72-77 liblist-moreutils-perl install Link Here
72
liblocale-currency-format-perl install
72
liblocale-currency-format-perl install
73
liblocale-gettext-perl	install
73
liblocale-gettext-perl	install
74
liblocale-po-perl	install
74
liblocale-po-perl	install
75
liblog-loglite-perl install
75
libmail-sendmail-perl install
76
libmail-sendmail-perl install
76
libmarc-charset-perl install
77
libmarc-charset-perl install
77
libmarc-crosswalk-dublincore-perl install
78
libmarc-crosswalk-dublincore-perl install
(-)a/installer/data/mysql/sysprefs.sql (+3 lines)
Lines 193-198 INSERT INTO systempreferences ( `variable`, `value`, `options`, `explanation`, ` Link Here
193
('LocalHoldsPriority',  '0', NULL,  'Enables the LocalHoldsPriority feature',  'YesNo'),
193
('LocalHoldsPriority',  '0', NULL,  'Enables the LocalHoldsPriority feature',  'YesNo'),
194
('LocalHoldsPriorityItemControl',  'holdingbranch',  'holdingbranch|homebranch',  'decides if the feature operates using the item''s home or holding library.',  'Choice'),
194
('LocalHoldsPriorityItemControl',  'holdingbranch',  'holdingbranch|homebranch',  'decides if the feature operates using the item''s home or holding library.',  'Choice'),
195
('LocalHoldsPriorityPatronControl',  'PickupLibrary',  'HomeLibrary|PickupLibrary',  'decides if the feature operates using the library set as the patron''s home library, or the library set as the pickup library for the given hold.',  'Choice'),
195
('LocalHoldsPriorityPatronControl',  'PickupLibrary',  'HomeLibrary|PickupLibrary',  'decides if the feature operates using the library set as the patron''s home library, or the library set as the pickup library for the given hold.',  'Choice'),
196
('LogLevel', '5', '1|2|3|4|5|6|7', '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'),
197
('LogToHtmlComments', '0', NULL, 'Embed the logs into the html as a comment.', 'YesNo'),
196
('ManInvInNoissuesCharge','1',NULL,'MANUAL_INV charges block checkouts (added to noissuescharge).','YesNo'),
198
('ManInvInNoissuesCharge','1',NULL,'MANUAL_INV charges block checkouts (added to noissuescharge).','YesNo'),
197
('MARCAuthorityControlField008','|| aca||aabn           | a|a     d',NULL,'Define the contents of MARC21 authority control field 008 position 06-39','Textarea'),
199
('MARCAuthorityControlField008','|| aca||aabn           | a|a     d',NULL,'Define the contents of MARC21 authority control field 008 position 06-39','Textarea'),
198
('MarcFieldsToOrder','',NULL,'Set the mapping values for a new order line created from a MARC record in a staged file. In a YAML format.','textarea'),
200
('MarcFieldsToOrder','',NULL,'Set the mapping values for a new order line created from a MARC record in a staged file. In a YAML format.','textarea'),
Lines 474-476 INSERT INTO systempreferences ( `variable`, `value`, `options`, `explanation`, ` Link Here
474
('z3950AuthorAuthFields','701,702,700',NULL,'Define the MARC biblio fields for Personal Name Authorities to fill biblio.author','free'),
476
('z3950AuthorAuthFields','701,702,700',NULL,'Define the MARC biblio fields for Personal Name Authorities to fill biblio.author','free'),
475
('z3950NormalizeAuthor','0','','If ON, Personal Name Authorities will replace authors in biblio.author','YesNo')
477
('z3950NormalizeAuthor','0','','If ON, Personal Name Authorities will replace authors in biblio.author','YesNo')
476
;
478
;
479
(-)a/installer/data/mysql/updatedatabase.pl (+12 lines)
Lines 9628-9633 if ( CheckVersion($DBversion) ) { Link Here
9628
    SetVersion($DBversion);
9628
    SetVersion($DBversion);
9629
}
9629
}
9630
9630
9631
$DBversion = "3.19.00.XXX";
9632
if ( CheckVersion($DBversion) ) {
9633
    $dbh->do(qq{
9634
        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');
9635
    });
9636
    $dbh->do(qq{
9637
        INSERT IGNORE INTO systempreferences (variable,value,explanation,options,type) VALUES ('LogToHtmlComments','0','Embed the logs into the html as a comment.','','YesNo');
9638
    });
9639
    print "Upgrade to $DBversion done (Bug 8190 - Add system preferences LogLevel, LogToHtmlComments)\n";
9640
    SetVersion($DBversion);
9641
}
9642
9631
=head1 FUNCTIONS
9643
=head1 FUNCTIONS
9632
9644
9633
=head2 TableExists($table)
9645
=head2 TableExists($table)
(-)a/koha-tmpl/intranet-tmpl/prog/en/includes/doc-head-open.inc (+5 lines)
Lines 2-4 Link Here
2
<!-- TEMPLATE FILE: [% template.name.split('/').last %] -->
2
<!-- TEMPLATE FILE: [% template.name.split('/').last %] -->
3
[% IF ( bidi ) %]<html lang="[% lang %]" dir="[% bidi %]">[% ELSE %]<html lang="[% lang %]">[% END %]
3
[% IF ( bidi ) %]<html lang="[% lang %]" dir="[% bidi %]">[% ELSE %]<html lang="[% lang %]">[% 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 157-159 Administration: Link Here
157
                  subscription: "subscription"
157
                  subscription: "subscription"
158
            - will be shown on the <a href="http://hea.koha-community.org">Hea Koha community website</a>.
158
            - will be shown on the <a href="http://hea.koha-community.org">Hea Koha community website</a>.
159
            - Note that this value has no effect if the UsageStats system preference is set to "Don't share"
159
            - Note that this value has no effect if the UsageStats system preference is set to "Don't share"
160
    Logger:
161
        -
162
            - Set the level
163
            - pref: LogLevel
164
              choices:
165
                1: 1- Unusable
166
                2: 2- Critical
167
                3: 3- Error
168
                4: 4- Warning
169
                5: 5- Normal
170
                6: 6- Info
171
                7: 7- Debug
172
            - for logs
173
        -
174
            - pref: LogToHtmlComments
175
              default: 0
176
              choices:
177
                  yes: Embed
178
                  no: "Don't embed"
179
            - log as a comment in the html.
(-)a/opac/opac-search.pl (+4 lines)
Lines 42-53 use C4::Branch; # GetBranches Link Here
42
use C4::SocialData;
42
use C4::SocialData;
43
use C4::Ratings;
43
use C4::Ratings;
44
use C4::External::OverDrive;
44
use C4::External::OverDrive;
45
use Koha::Utils::Logger qw/$log/;
45
46
46
use POSIX qw(ceil floor strftime);
47
use POSIX qw(ceil floor strftime);
47
use URI::Escape;
48
use URI::Escape;
48
use JSON qw/decode_json encode_json/;
49
use JSON qw/decode_json encode_json/;
49
use Business::ISBN;
50
use Business::ISBN;
50
51
52
$log = Koha::Utils::Logger->new({level => C4::Context->preference("LogLevel")});
53
51
my $DisplayMultiPlaceHold = C4::Context->preference("DisplayMultiPlaceHold");
54
my $DisplayMultiPlaceHold = C4::Context->preference("DisplayMultiPlaceHold");
52
# create a new CGI object
55
# create a new CGI object
53
# FIXME: no_undef_params needs to be tested
56
# FIXME: no_undef_params needs to be tested
Lines 548-553 if ($tag) { Link Here
548
    $pasarParams .= '&amp;count=' . uri_escape($results_per_page);
551
    $pasarParams .= '&amp;count=' . uri_escape($results_per_page);
549
    $pasarParams .= '&amp;simple_query=' . uri_escape($simple_query);
552
    $pasarParams .= '&amp;simple_query=' . uri_escape($simple_query);
550
    $pasarParams .= '&amp;query_type=' . uri_escape($query_type) if ($query_type);
553
    $pasarParams .= '&amp;query_type=' . uri_escape($query_type) if ($query_type);
554
    $log->info("OPAC: Search for $query");
551
    eval {
555
    eval {
552
        ($error, $results_hashref, $facets) = getRecords($query,$simple_query,\@sort_by,\@servers,$results_per_page,$offset,$expanded_facet,$branches,$itemtypes,$query_type,$scan,1);
556
        ($error, $results_hashref, $facets) = getRecords($query,$simple_query,\@sort_by,\@servers,$results_per_page,$offset,$expanded_facet,$branches,$itemtypes,$query_type,$scan,1);
553
    };
557
    };
(-)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