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

(-)a/C4/Auth.pm (+2 lines)
Lines 461-466 sub get_template_and_user { Link Here
461
461
462
        $template->param(OpacPublic => '1') if ($user || C4::Context->preference("OpacPublic"));
462
        $template->param(OpacPublic => '1') if ($user || C4::Context->preference("OpacPublic"));
463
    }
463
    }
464
465
    $template->param(Logger => C4::Context->logger() );
464
    return ( $template, $borrowernumber, $cookie, $flags);
466
    return ( $template, $borrowernumber, $cookie, $flags);
465
}
467
}
466
468
(-)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 (-41 / +67 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} =
61
      defined $params->{level} ? $params->{level} : $INFO_LOG_LEVEL;
62
    $self->{LOGGED_MESSAGES} = [];
63
57
    if ( not defined $self->{FILE_PATH} ) {
64
    if ( not defined $self->{FILE_PATH} ) {
58
        return bless($self, $class);
65
        return bless( $self, $class );
59
    }
66
    }
60
    eval {
67
    eval {
61
        $self->{LOGGER} = Log::LogLite->new($self->{FILE_PATH}, $self->{LEVEL});
68
        $self->{LOGGER} =
69
          Log::LogLite->new( $self->{FILE_PATH}, $self->{LEVEL} );
62
    };
70
    };
63
    die "Log system is not correctly configured ($@)" if $@;
71
    die "Log system is not correctly configured ($@)" if $@;
64
    return bless( $self, $class );
72
    return bless( $self, $class );
65
}
73
}
66
74
67
sub write {
75
sub write {
68
    my ($self, $msg, $log_level, $dump, $cb) = @_;
76
    my ( $self, $msg, $log_level, $dump, $cb ) = @_;
69
77
70
    if ( not $self->{LOGGER} ) {
78
    if ( not $self->{LOGGER} ) {
71
        if($log_level <= $self->{LEVEL}) {
79
        if ( $log_level <= $self->{LEVEL} ) {
72
            print STDERR "[" . localtime() . "] "
80
            print STDERR "["
73
                . "$LEVEL_STR->{$log_level}: "
81
              . localtime() . "] "
74
                . $msg
82
              . "$LEVEL_STR->{$log_level}: "
75
                . ( $cb ? " (" . $cb . ")" : "" )
83
              . $msg
76
                . "\n";
84
              . ( $cb ? " (" . $cb . ")" : "" ) . "\n";
77
        }
85
        }
78
        return;
86
        return;
79
    }
87
    }
Lines 82-145 sub write { Link Here
82
    $template .= "\n";
90
    $template .= "\n";
83
    $self->{LOGGER}->template($template);
91
    $self->{LOGGER}->template($template);
84
    $msg = "\n" . Dumper $msg if $dump;
92
    $msg = "\n" . Dumper $msg if $dump;
85
    $self->{LOGGER}->write($msg, $log_level);
93
    $self->{LOGGER}->write( $msg, $log_level );
94
95
if ( $log_level <= $self->{LEVEL} ) {
96
    my $message = "["
97
      . localtime() . "] "
98
      . "$LEVEL_STR->{$log_level}: "
99
      . $msg
100
      . ( $cb ? " (" . $cb . ")" : "" ) . "\n";
101
    push( @{ $self->{LOGGED_MESSAGES} }, $message );
102
}
86
}
103
}
87
104
88
sub unusable {
105
sub unusable {
89
    my ($self, $msg, $dump) = @_;
106
    my ( $self, $msg, $dump ) = @_;
90
    my $cb = $self->called_by();
107
    my $cb = $self->called_by();
91
    $self->write($msg, $UNUSABLE_LOG_LEVEL, $dump, $cb);
108
    $self->write( $msg, $UNUSABLE_LOG_LEVEL, $dump, $cb );
92
}
109
}
93
110
94
sub critical {
111
sub critical {
95
    my ($self, $msg, $dump) = @_;
112
    my ( $self, $msg, $dump ) = @_;
96
    my $cb = $self->called_by();
113
    my $cb = $self->called_by();
97
    $self->write($msg, $CRITICAL_LOG_LEVEL, $dump, $cb);
114
    $self->write( $msg, $CRITICAL_LOG_LEVEL, $dump, $cb );
98
}
115
}
99
116
100
sub error {
117
sub error {
101
    my ($self, $msg, $dump) = @_;
118
    my ( $self, $msg, $dump ) = @_;
102
    my $cb = $self->called_by();
119
    my $cb = $self->called_by();
103
    $self->write($msg, $ERROR_LOG_LEVEL, $dump, $cb);
120
    $self->write( $msg, $ERROR_LOG_LEVEL, $dump, $cb );
104
}
121
}
105
122
106
sub warning {
123
sub warning {
107
    my ($self, $msg, $dump) = @_;
124
    my ( $self, $msg, $dump ) = @_;
108
    my $cb = $self->called_by();
125
    my $cb = $self->called_by();
109
    $self->write($msg, $WARNING_LOG_LEVEL, $dump, $cb);
126
    $self->write( $msg, $WARNING_LOG_LEVEL, $dump, $cb );
110
}
127
}
111
128
112
sub log {
129
sub log {
113
    my ($self, $msg, $dump) = @_;
130
    my ( $self, $msg, $dump ) = @_;
114
    $self->write($msg, $NORMAL_LOG_LEVEL, $dump);
131
    $self->write( $msg, $NORMAL_LOG_LEVEL, $dump );
115
}
132
}
116
133
117
sub normal {
134
sub normal {
118
    my ($self, $msg, $dump) = @_;
135
    my ( $self, $msg, $dump ) = @_;
119
    $self->write($msg, $NORMAL_LOG_LEVEL, $dump);
136
    $self->write( $msg, $NORMAL_LOG_LEVEL, $dump );
120
}
137
}
121
138
122
sub info {
139
sub info {
123
    my ($self, $msg, $dump) = @_;
140
    my ( $self, $msg, $dump ) = @_;
124
    $self->write($msg, $INFO_LOG_LEVEL, $dump);
141
    $self->write( $msg, $INFO_LOG_LEVEL, $dump );
125
}
142
}
126
143
127
sub debug {
144
sub debug {
128
    my ($self, $msg, $dump) = @_;
145
    my ( $self, $msg, $dump ) = @_;
129
    $self->write($msg, $DEBUG_LOG_LEVEL, $dump);
146
    $self->write( $msg, $DEBUG_LOG_LEVEL, $dump );
130
}
147
}
131
148
132
sub level {
149
sub level {
133
    my $self = shift;
150
    my $self = shift;
134
151
135
    return $self->{LOGGER}
152
    return $self->{LOGGER}
136
           ? $self->{LOGGER}->level(@_)
153
      ? $self->{LOGGER}->level(@_)
137
           : ($self->{LEVEL} = @_ ? shift : $self->{LEVEL});
154
      : ( $self->{LEVEL} = @_ ? shift : $self->{LEVEL} );
138
}
155
}
139
156
140
141
sub called_by {
157
sub called_by {
142
    my $self = shift;
158
    my $self  = shift;
143
    my $depth = 2;
159
    my $depth = 2;
144
    my $args;
160
    my $args;
145
    my $pack;
161
    my $pack;
Lines 154-168 sub called_by { Link Here
154
    my $bitmask;
170
    my $bitmask;
155
    my @subr;
171
    my @subr;
156
    my $str = "";
172
    my $str = "";
173
157
    while (1) {
174
    while (1) {
158
        ($pack, $file, $line, $subr, $has_args, $wantarray, $evaltext,
175
        (
159
         $is_require, $hints, $bitmask) = caller($depth);
176
            $pack,      $file,     $line,       $subr,  $has_args,
160
        unless (defined($subr)) {
177
            $wantarray, $evaltext, $is_require, $hints, $bitmask
178
        ) = caller($depth);
179
        unless ( defined($subr) ) {
161
            last;
180
            last;
162
        }
181
        }
163
        $depth++;
182
        $depth++;
164
        $line = (3) ? "$file:".$line."-->" : "";
183
        $line = (3) ? "$file:" . $line . "-->" : "";
165
        push(@subr, $line.$subr);
184
        push( @subr, $line . $subr );
166
    }
185
    }
167
    @subr = reverse(@subr);
186
    @subr = reverse(@subr);
168
    foreach my $sr (@subr) {
187
    foreach my $sr (@subr) {
Lines 171-176 sub called_by { Link Here
171
    }
190
    }
172
    $str =~ s/ > $/: /;
191
    $str =~ s/ > $/: /;
173
    return $str;
192
    return $str;
174
} # of called_by
193
}    # of called_by
194
195
sub get_messages {
196
    my $self = shift;
197
198
    return $self->{LOGGED_MESSAGES}
199
}
200
175
201
176
1;
202
1;
(-)a/koha-tmpl/intranet-tmpl/prog/en/includes/doc-head-open.inc (+3 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
<!-- LOG MESSAGES 
6
[% FOREACH message IN Logger.get_messages() %][% message %][% END %] 
7
-->
(-)a/mainpage.pl (-1 / +2 lines)
Lines 60-63 $template->param( Link Here
60
    pendingsuggestions => $pendingsuggestions
60
    pendingsuggestions => $pendingsuggestions
61
);
61
);
62
62
63
C4::Context->logger->error( "an error string");
64
C4::Context->logger->normal( "a normal string");
63
output_html_with_http_headers $query, $cookie, $template->output;
65
output_html_with_http_headers $query, $cookie, $template->output;
64
- 

Return to bug 8190