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 1130-1135 sub tz { Link Here
1130
    return $context->{tz};
1132
    return $context->{tz};
1131
}
1133
}
1132
1134
1135
=head2 logger
1136
1137
  $logger = C4::Context->logger;
1138
1139
Returns a Koha logger. If no logger has yet been instantiated,
1140
this method creates one, and caches it.
1141
1142
=cut
1143
1144
sub logger
1145
{
1146
    my $self = shift;
1147
    my $sth;
1148
1149
    if ( defined( $context->{"logger"} ) ) {
1150
	return $context->{"logger"};
1151
    }
1152
1153
    $context->{"logger"} = Koha::Utils::Logger->new(
1154
        {
1155
            level => C4::Context->preference("LogLevel")
1156
        }
1157
    );
1158
1159
    return $context->{"logger"};
1160
}
1133
1161
1134
1162
1135
1;
1163
1;
(-)a/Koha/Utils/Logger.pm (-42 / +52 lines)
Lines 48-79 our $log = undef; Link Here
48
sub new {
48
sub new {
49
    my ( $proto, $params ) = @_;
49
    my ( $proto, $params ) = @_;
50
50
51
    return $log if $log and ( not defined $params->{file} or not defined $log->{FILE_PATH} or $params->{file} eq $log->{FILE_PATH} );
51
    return $log
52
    my $class = ref($proto) || $proto;
52
      if $log
53
    my $self = {};
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     = {};
54
    my $LOG_PATH = defined $ENV{KOHA_LOG} ? $ENV{KOHA_LOG} : undef;
58
    my $LOG_PATH = defined $ENV{KOHA_LOG} ? $ENV{KOHA_LOG} : undef;
55
    $self->{FILE_PATH} = defined $params->{file}  ? $params->{file}  : $LOG_PATH;
59
    $self->{FILE_PATH} = defined $params->{file}  ? $params->{file}  : $LOG_PATH;
56
    $self->{LEVEL} = defined $params->{level} ? $params->{level} : $INFO_LOG_LEVEL;
60
    $self->{LEVEL}     = defined $params->{level} ? $params->{level} : $INFO_LOG_LEVEL;
61
    $self->{LOGGED_MESSAGES} = [];
62
57
    if ( not defined $self->{FILE_PATH} ) {
63
    if ( not defined $self->{FILE_PATH} ) {
58
        return bless($self, $class);
64
        return bless( $self, $class );
59
    }
65
    }
60
    eval {
66
    eval { $self->{LOGGER} = Log::LogLite->new( $self->{FILE_PATH}, $self->{LEVEL} ); };
61
        $self->{LOGGER} = Log::LogLite->new($self->{FILE_PATH}, $self->{LEVEL});
62
    };
63
    die "Log system is not correctly configured ($@)" if $@;
67
    die "Log system is not correctly configured ($@)" if $@;
64
    return bless( $self, $class );
68
    return bless( $self, $class );
65
}
69
}
66
70
67
sub write {
71
sub write {
68
    my ($self, $msg, $log_level, $dump, $cb) = @_;
72
    my ( $self, $msg, $log_level, $dump, $cb ) = @_;
69
73
70
    if ( not $self->{LOGGER} ) {
74
    if ( not $self->{LOGGER} ) {
71
        if($log_level <= $self->{LEVEL}) {
75
        if ( $log_level <= $self->{LEVEL} ) {
72
            print STDERR "[" . localtime() . "] "
76
            print STDERR "[" . localtime() . "] " . "$LEVEL_STR->{$log_level}: " . $msg . ( $cb ? " (" . $cb . ")" : "" ) . "\n";
73
                . "$LEVEL_STR->{$log_level}: "
74
                . $msg
75
                . ( $cb ? " (" . $cb . ")" : "" )
76
                . "\n";
77
        }
77
        }
78
        return;
78
        return;
79
    }
79
    }
Lines 82-145 sub write { Link Here
82
    $template .= "\n";
82
    $template .= "\n";
83
    $self->{LOGGER}->template($template);
83
    $self->{LOGGER}->template($template);
84
    $msg = "\n" . Dumper $msg if $dump;
84
    $msg = "\n" . Dumper $msg if $dump;
85
    $self->{LOGGER}->write($msg, $log_level);
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
    }
86
}
91
}
87
92
88
sub unusable {
93
sub unusable {
89
    my ($self, $msg, $dump) = @_;
94
    my ( $self, $msg, $dump ) = @_;
90
    my $cb = $self->called_by();
95
    my $cb = $self->called_by();
91
    $self->write($msg, $UNUSABLE_LOG_LEVEL, $dump, $cb);
96
    $self->write( $msg, $UNUSABLE_LOG_LEVEL, $dump, $cb );
92
}
97
}
93
98
94
sub critical {
99
sub critical {
95
    my ($self, $msg, $dump) = @_;
100
    my ( $self, $msg, $dump ) = @_;
96
    my $cb = $self->called_by();
101
    my $cb = $self->called_by();
97
    $self->write($msg, $CRITICAL_LOG_LEVEL, $dump, $cb);
102
    $self->write( $msg, $CRITICAL_LOG_LEVEL, $dump, $cb );
98
}
103
}
99
104
100
sub error {
105
sub error {
101
    my ($self, $msg, $dump) = @_;
106
    my ( $self, $msg, $dump ) = @_;
102
    my $cb = $self->called_by();
107
    my $cb = $self->called_by();
103
    $self->write($msg, $ERROR_LOG_LEVEL, $dump, $cb);
108
    $self->write( $msg, $ERROR_LOG_LEVEL, $dump, $cb );
104
}
109
}
105
110
106
sub warning {
111
sub warning {
107
    my ($self, $msg, $dump) = @_;
112
    my ( $self, $msg, $dump ) = @_;
108
    my $cb = $self->called_by();
113
    my $cb = $self->called_by();
109
    $self->write($msg, $WARNING_LOG_LEVEL, $dump, $cb);
114
    $self->write( $msg, $WARNING_LOG_LEVEL, $dump, $cb );
110
}
115
}
111
116
112
sub log {
117
sub log {
113
    my ($self, $msg, $dump) = @_;
118
    my ( $self, $msg, $dump ) = @_;
114
    $self->write($msg, $NORMAL_LOG_LEVEL, $dump);
119
    $self->write( $msg, $NORMAL_LOG_LEVEL, $dump );
115
}
120
}
116
121
117
sub normal {
122
sub normal {
118
    my ($self, $msg, $dump) = @_;
123
    my ( $self, $msg, $dump ) = @_;
119
    $self->write($msg, $NORMAL_LOG_LEVEL, $dump);
124
    $self->write( $msg, $NORMAL_LOG_LEVEL, $dump );
120
}
125
}
121
126
122
sub info {
127
sub info {
123
    my ($self, $msg, $dump) = @_;
128
    my ( $self, $msg, $dump ) = @_;
124
    $self->write($msg, $INFO_LOG_LEVEL, $dump);
129
    $self->write( $msg, $INFO_LOG_LEVEL, $dump );
125
}
130
}
126
131
127
sub debug {
132
sub debug {
128
    my ($self, $msg, $dump) = @_;
133
    my ( $self, $msg, $dump ) = @_;
129
    $self->write($msg, $DEBUG_LOG_LEVEL, $dump);
134
    $self->write( $msg, $DEBUG_LOG_LEVEL, $dump );
130
}
135
}
131
136
132
sub level {
137
sub level {
133
    my $self = shift;
138
    my $self = shift;
134
139
135
    return $self->{LOGGER}
140
    return $self->{LOGGER}
136
           ? $self->{LOGGER}->level(@_)
141
      ? $self->{LOGGER}->level(@_)
137
           : ($self->{LEVEL} = @_ ? shift : $self->{LEVEL});
142
      : ( $self->{LEVEL} = @_ ? shift : $self->{LEVEL} );
138
}
143
}
139
144
140
141
sub called_by {
145
sub called_by {
142
    my $self = shift;
146
    my $self  = shift;
143
    my $depth = 2;
147
    my $depth = 2;
144
    my $args;
148
    my $args;
145
    my $pack;
149
    my $pack;
Lines 154-168 sub called_by { Link Here
154
    my $bitmask;
158
    my $bitmask;
155
    my @subr;
159
    my @subr;
156
    my $str = "";
160
    my $str = "";
161
157
    while (1) {
162
    while (1) {
158
        ($pack, $file, $line, $subr, $has_args, $wantarray, $evaltext,
163
        ( $pack, $file, $line, $subr, $has_args, $wantarray, $evaltext, $is_require, $hints, $bitmask ) = caller($depth);
159
         $is_require, $hints, $bitmask) = caller($depth);
164
        unless ( defined($subr) ) {
160
        unless (defined($subr)) {
161
            last;
165
            last;
162
        }
166
        }
163
        $depth++;
167
        $depth++;
164
        $line = (3) ? "$file:".$line."-->" : "";
168
        $line = (3) ? "$file:" . $line . "-->" : "";
165
        push(@subr, $line.$subr);
169
        push( @subr, $line . $subr );
166
    }
170
    }
167
    @subr = reverse(@subr);
171
    @subr = reverse(@subr);
168
    foreach my $sr (@subr) {
172
    foreach my $sr (@subr) {
Lines 171-176 sub called_by { Link Here
171
    }
175
    }
172
    $str =~ s/ > $/: /;
176
    $str =~ s/ > $/: /;
173
    return $str;
177
    return $str;
174
} # of called_by
178
}    # of called_by
179
180
sub get_messages {
181
    my $self = shift;
182
183
    return $self->{LOGGED_MESSAGES};
184
}
175
185
176
1;
186
1;
(-)a/installer/data/mysql/sysprefs.sql (+2 lines)
Lines 386-388 INSERT INTO systempreferences (variable,value,explanation,type) VALUES('OPACdidy Link Here
386
INSERT INTO systempreferences (variable,value,explanation,type) VALUES('INTRAdidyoumean',NULL,'Did you mean? configuration for the Intranet. Do not change, as this is controlled by /cgi-bin/koha/admin/didyoumean.pl.','Free');
386
INSERT INTO systempreferences (variable,value,explanation,type) VALUES('INTRAdidyoumean',NULL,'Did you mean? configuration for the Intranet. Do not change, as this is controlled by /cgi-bin/koha/admin/didyoumean.pl.','Free');
387
INSERT INTO systempreferences (variable, value, options, explanation, type) VALUES ('BlockReturnOfWithdrawnItems', '1', '0', 'If enabled, items that are marked as withdrawn cannot be returned.', 'YesNo');
387
INSERT INTO systempreferences (variable, value, options, explanation, type) VALUES ('BlockReturnOfWithdrawnItems', '1', '0', 'If enabled, items that are marked as withdrawn cannot be returned.', 'YesNo');
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 ('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');
390
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 / +4 lines)
Lines 5791-5797 if ( C4::Context->preference("Version") < TransformToNum($DBversion) ) { Link Here
5791
    $dbh->do(qq{
5791
    $dbh->do(qq{
5792
        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');
5792
        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');
5793
    });
5793
    });
5794
    print "Upgrade to $DBversion done (Add system preference LogLevel)\n";
5794
    $dbh->do(qq{
5795
        INSERT IGNORE INTO systempreferences (variable,value,explanation,options,type) VALUES ('LogToHtmlComments','0','Embed the logs into the html as a comment.','','YesNo');
5796
    });
5797
    print "Upgrade to $DBversion done (Add system preferences LogLevel, LogToHtmlComments)\n";
5795
    SetVersion($DBversion);
5798
    SetVersion($DBversion);
5796
}
5799
}
5797
5800
(-)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 (-1 / +7 lines)
Lines 125-127 Administration: Link Here
125
                6: 6- Info
125
                6: 6- Info
126
                7: 7- Debug
126
                7: 7- Debug
127
            - for logs
127
            - for logs
128
- 
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.

Return to bug 8190