Bug 14167: (QA followup) Making Koha::Logger bit more crash resistant

Moving the BEGIN block to _init for the most part. We only need to
initialize when we actually start using the logger.
Removed the third init part. If we do not have a log4perl_conf in the
koha config, we are not using it yet.
Method get uses hash parameters now. It calls init. If we do not have a
config or the logfile is not writable, we will not use log4perl.
Using AUTOLOAD as a wrapper around Log4perl in order to add some checks
that log4perl does not have.
If a logrotate would change file permissions on a default logfile, we
should catch that now too (see recheck).

Test plan:
Run the previous tests again.
Will still add a unit test.

Signed-off-by: Kyle M Hall <kyle@bywatersolutions.com>
Signed-off-by: Tomas Cohen Arazi <tomascohen@unc.edu.ar>

diff --git a/Koha/Logger.pm b/Koha/Logger.pm
index a3b58ab..7947657 100644 (file)
--- a/Koha/Logger.pm
+++ b/Koha/Logger.pm
@@ -39,54 +39,139 @@ use C4::Context;
 
 BEGIN {
     Log::Log4perl->wrapper_register(__PACKAGE__);
-
-    if ( exists $ENV{"LOG4PERL_CONF"} and $ENV{'LOG4PERL_CONF'} and -s $ENV{"LOG4PERL_CONF"} ) {
-        # Check for web server level configuration first
-        Log::Log4perl->init_once( $ENV{"LOG4PERL_CONF"} );
-    }
-    elsif ( C4::Context->config("log4perl_conf") ) {
-        # If no web server level config exists, look in the koha conf file for one
-        Log::Log4perl->init_once( C4::Context->config("log4perl_conf") );
-    } else {
-        my $logdir = C4::Context->config("logdir");
-        my $conf = qq(
-            log4perl.logger.intranet = WARN, INTRANET
-            log4perl.appender.INTRANET=Log::Log4perl::Appender::File
-            log4perl.appender.INTRANET.filename=$logdir/intranet-error.log
-            log4perl.appender.INTRANET.mode=append
-            log4perl.appender.INTRANET.layout=PatternLayout
-            log4perl.appender.INTRANET.layout.ConversionPattern=[%d] [%p] %m %l %n
-
-            log4perl.logger.opac = WARN, OPAC
-            log4perl.appender.OPAC=Log::Log4perl::Appender::File
-            log4perl.appender.OPAC.filename=$logdir/opac-error.log
-            log4perl.appender.OPAC.mode=append
-            log4perl.appender.OPAC.layout=PatternLayout
-            log4perl.appender.OPAC.layout.ConversionPattern=[%d] [%p] %m %l %n
-        );
-        Log::Log4perl->init_once(\$conf);
-    }
 }
 
 =head2 get
 
-    Returns a log4perl object.
-    Category and interface parameter are optional.
+    Returns a logger object (based on log4perl).
+    Category and interface hash parameter are optional.
     Normally, the category should follow the current package and the interface
     should be set correctly via C4::Context.
 
 =cut
 
 sub get {
-    my ( $class, $category, $interface ) = @_;
-    $interface ||= C4::Context->interface();
-    $category = caller if !$category;
-    return Log::Log4perl->get_logger( $interface. '.'. $category );
+    my ( $class, $params ) = @_;
+    my $interface = $params? ($params->{interface} || C4::Context->interface):
+        C4::Context->interface;
+    my $category = $params? ($params->{category} || caller): caller;
+    my $l4pcat= $interface. '.'. $category;
+
+    my $init= _init();
+    my $self = {};
+    if( $init ) {
+        $self->{logger} = Log::Log4perl->get_logger( $l4pcat );
+        $self->{cat} = $l4pcat;
+        $self->{logs} = $init if ref $init;
+    }
+    bless $self, $class;
+    return $self;
+}
+
+=head1 INTERNALS
+
+=head2 AUTOLOAD
+
+    In order to prevent a crash when log4perl cannot write to Koha logfile,
+    we check first before calling log4perl.
+    If log4perl would add such a check, this would no longer be needed.
+
+=cut
+
+sub AUTOLOAD {
+    my ( $self, $line ) = @_;
+    my $method= $Koha::Logger::AUTOLOAD;
+    $method =~ s/^Koha::Logger:://;
+
+    if( !exists $self->{logger} ) {
+        #do not use log4perl; no print to stderr
+    } elsif( !$self->_recheck_logfile ) {
+        print STDERR "Log file not writable for log4perl\n";
+        print STDERR "$method: $line\n" if $line;
+    } elsif( $self->{logger}->can($method) ) { #use log4perl
+        $self->{logger}->$method( $line );
+        return 1;
+    } else { # we should not really get here
+        print STDERR "ERROR: Unsupported method $method\n";
+    }
+    return;
+}
+
+=head2 DESTROY
+
+    Dummy destroy to prevent call to AUTOLOAD
+
+=cut
+
+sub DESTROY {}
+
+=head2 _init, _check_conf and _recheck_logfile
+
+=cut
+
+sub _init {
+    my $rv;
+    if ( exists $ENV{"LOG4PERL_CONF"} and $ENV{'LOG4PERL_CONF'} and -s $ENV{"LOG4PERL_CONF"} ) {
+        # Check for web server level configuration first
+        # In this case we ASSUME that you correctly arranged logfile
+        # permissions. If not, log4perl will crash on you.
+        # We will not parse apache files here.
+        Log::Log4perl->init_once( $ENV{"LOG4PERL_CONF"} );
+    } elsif ( C4::Context->config("log4perl_conf") ) {
+        # Now look in the koha conf file. We only check the permissions of
+        # the default logfiles. For the rest, we again ASSUME that
+        # you arranged file permissions.
+        my $conf= C4::Context->config("log4perl_conf");
+        if( $rv = _check_conf($conf) ) {
+            Log::Log4perl->init_once( $conf );
+            return $rv;
+        } else {
+            return 0;
+        }
+    } else {
+       # This means that you do not use log4perl currently.
+       # We will not be forcing it.
+       return 0;
+    }
+    return 1; # if we make it here, log4perl did not crash :)
+}
+
+sub _check_conf { # check logfiles in log4perl config (at initialization)
+    my $file = shift;
+    return if !-r $file;
+    open my $fh, '<', $file;
+    my @lines = <$fh>;
+    close $fh;
+    my @logs;
+    foreach my $l ( @lines ) {
+        if( $l =~ /(OPAC|INTRANET)\.filename\s*=\s*(.*)\s*$/i ) {
+        # we only check the two default logfiles, skipping additional ones
+            return if !-w $2;
+            push @logs, $1.':'.$2;
+        }
+    }
+    return if !@logs; # we should find one
+    return \@logs;
+}
+
+sub _recheck_logfile { # recheck saved logfile when logging message
+    my $self = shift;
+
+    return 1 if !exists $self->{logs}; # remember? your own responsibility
+    my $opac= $self->{cat}=~ /^OPAC/;
+    my $log;
+    foreach( @{$self->{logs}} ) {
+        $log=$_ if $opac && /^OPAC:/ || !$opac && /^INTRANET:/;
+        last if $log;
+    }
+    $log =~ s/^(OPAC|INTRANET)://;
+    return -w $log;
 }
 
 =head1 AUTHOR
 
 Kyle M Hall, E<lt>kyle@bywatersolutions.comE<gt>
+Marcel de Rooy, Rijksmuseum
 
 =cut