Bug 20744: Replace staff client header Koha logo gif with transparent png
[koha.git] / Koha / Logger.pm
blobed85c99d72916fc300b6d5dbaefbb794d2a3b50f
1 package Koha::Logger;
3 # Copyright 2015 ByWater Solutions
4 # kyle@bywatersolutions.com
6 # This file is part of Koha.
8 # Koha is free software; you can redistribute it and/or modify it under the
9 # terms of the GNU General Public License as published by the Free Software
10 # Foundation; either version 3 of the License, or (at your option) any later
11 # version.
13 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
14 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
15 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
17 # You should have received a copy of the GNU General Public License along
18 # with Koha; if not, write to the Free Software Foundation, Inc.,
19 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
21 =head1 NAME
23 Koha::Logger
25 =head1 SYNOPSIS
27 use Koha::Logger;
29 my $logger = Koha::Logger->get;
30 $logger->warn( 'WARNING: Serious error encountered' );
31 $logger->debug( 'I thought that this code was not used' );
33 =head1 FUNCTIONS
35 =cut
37 use Modern::Perl;
39 use Log::Log4perl;
40 use Carp;
42 use C4::Context;
44 BEGIN {
45 Log::Log4perl->wrapper_register(__PACKAGE__);
48 =head2 get
50 Returns a logger object (based on log4perl).
51 Category and interface hash parameter are optional.
52 Normally, the category should follow the current package and the interface
53 should be set correctly via C4::Context.
55 =cut
57 sub get {
58 my ( $class, $params ) = @_;
59 my $interface = $params ? ( $params->{interface} || C4::Context->interface ) : C4::Context->interface;
60 my $category = $params ? ( $params->{category} || caller ) : caller;
61 my $l4pcat = $interface . '.' . $category;
63 my $init = _init();
64 my $self = {};
65 if ($init) {
66 $self->{logger} = Log::Log4perl->get_logger($l4pcat);
67 $self->{cat} = $l4pcat;
68 $self->{logs} = $init if ref $init;
70 bless $self, $class;
71 return $self;
74 =head1 INTERNALS
76 =head2 AUTOLOAD
78 In order to prevent a crash when log4perl cannot write to Koha logfile,
79 we check first before calling log4perl.
80 If log4perl would add such a check, this would no longer be needed.
82 =cut
84 sub AUTOLOAD {
85 my ( $self, $line ) = @_;
86 my $method = $Koha::Logger::AUTOLOAD;
87 $method =~ s/^Koha::Logger:://;
89 if ( !exists $self->{logger} ) {
91 #do not use log4perl; no print to stderr
93 elsif ( !$self->_recheck_logfile ) {
94 warn "Log file not writable for log4perl";
95 warn "$method: $line" if $line;
97 elsif ( $self->{logger}->can($method) ) { #use log4perl
98 $self->{logger}->$method($line);
99 return 1;
101 else { # we should not really get here
102 warn "ERROR: Unsupported method $method";
104 return;
107 =head2 DESTROY
109 Dummy destroy to prevent call to AUTOLOAD
111 =cut
113 sub DESTROY { }
115 =head2 _init, _check_conf and _recheck_logfile
117 =cut
119 sub _init {
120 my $rv;
121 if ( exists $ENV{"LOG4PERL_CONF"} and $ENV{'LOG4PERL_CONF'} and -s $ENV{"LOG4PERL_CONF"} ) {
123 # Check for web server level configuration first
124 # In this case we ASSUME that you correctly arranged logfile
125 # permissions. If not, log4perl will crash on you.
126 # We will not parse apache files here.
127 Log::Log4perl->init_once( $ENV{"LOG4PERL_CONF"} );
129 elsif ( C4::Context->config("log4perl_conf") ) {
131 # Now look in the koha conf file. We only check the permissions of
132 # the default logfiles. For the rest, we again ASSUME that
133 # you arranged file permissions.
134 my $conf = C4::Context->config("log4perl_conf");
135 if ( $rv = _check_conf($conf) ) {
136 Log::Log4perl->init_once($conf);
137 return $rv;
139 else {
140 return 0;
143 else {
144 # This means that you do not use log4perl currently.
145 # We will not be forcing it.
146 return 0;
148 return 1; # if we make it here, log4perl did not crash :)
151 sub _check_conf { # check logfiles in log4perl config (at initialization)
152 my $file = shift;
153 return if !-r $file;
154 open my $fh, '<', $file;
155 my @lines = <$fh>;
156 close $fh;
157 my @logs;
158 foreach my $l (@lines) {
159 if ( $l =~ /(OPAC|INTRANET)\.filename\s*=\s*(.*)\s*$/i ) {
161 # we only check the two default logfiles, skipping additional ones
162 return if !-w $2;
163 push @logs, $1 . ':' . $2;
166 return if !@logs; # we should find one
167 return \@logs;
170 sub _recheck_logfile { # recheck saved logfile when logging message
171 my $self = shift;
173 return 1 if !exists $self->{logs}; # remember? your own responsibility
174 my $opac = $self->{cat} =~ /^OPAC/;
175 my $log;
176 foreach ( @{ $self->{logs} } ) {
177 $log = $_ if $opac && /^OPAC:/ || !$opac && /^INTRANET:/;
178 last if $log;
180 $log =~ s/^(OPAC|INTRANET)://;
181 return -w $log;
184 =head1 AUTHOR
186 Kyle M Hall, E<lt>kyle@bywatersolutions.comE<gt>
187 Marcel de Rooy, Rijksmuseum
189 =cut
193 __END__