@@ -, +, @@ resistant --- Koha/Logger.pm | 151 +++++++++++++++++++++++++++++++++++++++++++------------- 1 file changed, 118 insertions(+), 33 deletions(-) --- a/Koha/Logger.pm +++ a/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, Ekyle@bywatersolutions.comE +Marcel de Rooy, Rijksmuseum =cut --