X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=Koha%2FLogger.pm;h=ed85c99d72916fc300b6d5dbaefbb794d2a3b50f;hb=58dccaee26181b42ab3a435e4b84786e3a75bcd3;hp=a3b58ab9e638974896e8306367b14cbc01bcf34b;hpb=25df3abb22e6f36ed80e8510f1e3b9f2150f1b2c;p=koha.git

diff --git a/Koha/Logger.pm b/Koha/Logger.pm
index a3b58ab9e6..ed85c99d72 100644
--- a/Koha/Logger.pm
+++ b/Koha/Logger.pm
@@ -20,11 +20,15 @@ package Koha::Logger;
 
 =head1 NAME
 
-Koha::Log
+Koha::Logger
 
 =head1 SYNOPSIS
 
-  use Koha::Log;
+    use Koha::Logger;
+
+    my $logger = Koha::Logger->get;
+    $logger->warn( 'WARNING: Serious error encountered' );
+    $logger->debug( 'I thought that this code was not used' );
 
 =head1 FUNCTIONS
 
@@ -39,54 +43,148 @@ use C4::Context;
 
 BEGIN {
     Log::Log4perl->wrapper_register(__PACKAGE__);
+}
+
+=head2 get
+
+    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, $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 ) {
+        warn "Log file not writable for log4perl";
+        warn "$method: $line" if $line;
+    }
+    elsif ( $self->{logger}->can($method) ) {    #use log4perl
+        $self->{logger}->$method($line);
+        return 1;
+    }
+    else {                                       # we should not really get here
+        warn "ERROR: Unsupported method $method";
+    }
+    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") ) {
-        # 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);
+
+        # 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 :)
 }
 
-=head2 get
-
-    Returns a log4perl object.
-    Category and interface parameter are optional.
-    Normally, the category should follow the current package and the interface
-    should be set correctly via C4::Context.
+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;
+}
 
-=cut
+sub _recheck_logfile {    # recheck saved logfile when logging message
+    my $self = shift;
 
-sub get {
-    my ( $class, $category, $interface ) = @_;
-    $interface ||= C4::Context->interface();
-    $category = caller if !$category;
-    return Log::Log4perl->get_logger( $interface. '.'. $category );
+    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