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
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.
41 Log::Log4perl->wrapper_register(__PACKAGE__);
46 Returns a logger object (based on log4perl).
47 Category and interface hash parameter are optional.
48 Normally, the category should follow the current package and the interface
49 should be set correctly via C4::Context.
54 my ( $class, $params ) = @_;
55 my $interface = $params? ($params->{interface} || C4::Context->interface):
56 C4::Context->interface;
57 my $category = $params? ($params->{category} || caller): caller;
58 my $l4pcat= $interface. '.'. $category;
63 $self->{logger} = Log::Log4perl->get_logger( $l4pcat );
64 $self->{cat} = $l4pcat;
65 $self->{logs} = $init if ref $init;
75 In order to prevent a crash when log4perl cannot write to Koha logfile,
76 we check first before calling log4perl.
77 If log4perl would add such a check, this would no longer be needed.
82 my ( $self, $line ) = @_;
83 my $method= $Koha::Logger::AUTOLOAD;
84 $method =~ s/^Koha::Logger:://;
86 if( !exists $self->{logger} ) {
87 #do not use log4perl; no print to stderr
88 } elsif( !$self->_recheck_logfile ) {
89 print STDERR "Log file not writable for log4perl\n";
90 print STDERR "$method: $line\n" if $line;
91 } elsif( $self->{logger}->can($method) ) { #use log4perl
92 $self->{logger}->$method( $line );
94 } else { # we should not really get here
95 print STDERR "ERROR: Unsupported method $method\n";
102 Dummy destroy to prevent call to AUTOLOAD
108 =head2 _init, _check_conf and _recheck_logfile
114 if ( exists $ENV{"LOG4PERL_CONF"} and $ENV{'LOG4PERL_CONF'} and -s $ENV{"LOG4PERL_CONF"} ) {
115 # Check for web server level configuration first
116 # In this case we ASSUME that you correctly arranged logfile
117 # permissions. If not, log4perl will crash on you.
118 # We will not parse apache files here.
119 Log::Log4perl->init_once( $ENV{"LOG4PERL_CONF"} );
120 } elsif ( C4::Context->config("log4perl_conf") ) {
121 # Now look in the koha conf file. We only check the permissions of
122 # the default logfiles. For the rest, we again ASSUME that
123 # you arranged file permissions.
124 my $conf= C4::Context->config("log4perl_conf");
125 if( $rv = _check_conf($conf) ) {
126 Log::Log4perl->init_once( $conf );
132 # This means that you do not use log4perl currently.
133 # We will not be forcing it.
136 return 1; # if we make it here, log4perl did not crash :)
139 sub _check_conf { # check logfiles in log4perl config (at initialization)
142 open my $fh, '<', $file;
146 foreach my $l ( @lines ) {
147 if( $l =~ /(OPAC|INTRANET)\.filename\s*=\s*(.*)\s*$/i ) {
148 # we only check the two default logfiles, skipping additional ones
150 push @logs, $1.':'.$2;
153 return if !@logs; # we should find one
157 sub _recheck_logfile { # recheck saved logfile when logging message
160 return 1 if !exists $self->{logs}; # remember? your own responsibility
161 my $opac= $self->{cat}=~ /^OPAC/;
163 foreach( @{$self->{logs}} ) {
164 $log=$_ if $opac && /^OPAC:/ || !$opac && /^INTRANET:/;
167 $log =~ s/^(OPAC|INTRANET)://;
173 Kyle M Hall, E<lt>kyle@bywatersolutions.comE<gt>
174 Marcel de Rooy, Rijksmuseum