Koha-community/Koha
13
7
Fork 0
Code Issues Releases Wiki Activity

Bug 14167: (QA followup) Tidy Koha/Logger.pm

Browse source 
Signed-off-by: Tomas Cohen Arazi <tomascohen@unc.edu.ar>
This commit is contained in:
Kyle Hall 2015-06-25 14:23:48 -04:00 committed by Tomas Cohen Arazi
parent c339b5e4cc
commit e32d731238
1 changed files with 46 additions and 37 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

83
Koha/Logger.pm
View file

@ -52,17 +52,16 @@ BEGIN {
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 $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 $init = _init();
my $self = {};
if( $init ) {
$self->{logger} = Log::Log4perl->get_logger( $l4pcat );
$self->{cat} = $l4pcat;
$self->{logs} = $init if ref $init;
if ($init) {
$self->{logger} = Log::Log4perl->get_logger($l4pcat);
$self->{cat} = $l4pcat;
$self->{logs} = $init if ref $init;
}
bless $self, $class;
return $self;
@ -80,18 +79,22 @@ sub get {
sub AUTOLOAD {
my ( $self, $line ) = @_;
my $method= $Koha::Logger::AUTOLOAD;
my $method = $Koha::Logger::AUTOLOAD;
$method =~ s/^Koha::Logger:://;
if( !exists $self->{logger} ) {
if ( !exists $self->{logger} ) {
#do not use log4perl; no print to stderr
} elsif( !$self->_recheck_logfile ) {
}
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 );
}
elsif ( $self->{logger}->can($method) ) { #use log4perl
$self->{logger}->$method($line);
return 1;
} else { # we should not really get here
}
else { # we should not really get here
print STDERR "ERROR: Unsupported method $method\n";
}
return;
@ -103,7 +106,7 @@ sub AUTOLOAD {
=cut
sub DESTROY {}
sub DESTROY { }
=head2 _init, _check_conf and _recheck_logfile
@ -112,56 +115,62 @@ sub DESTROY {}
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") ) {
}
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 );
my $conf = C4::Context->config("log4perl_conf");
if ( $rv = _check_conf($conf) ) {
Log::Log4perl->init_once($conf);
return $rv;
} else {
}
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 :)
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)
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
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;
push @logs, $1 . ':' . $2;
}
}
return if !@logs; # we should find one
return if !@logs; # we should find one
return \@logs;
}
sub _recheck_logfile { # recheck saved logfile when logging message
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/;
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:/;
foreach ( @{ $self->{logs} } ) {
$log = $_ if $opac && /^OPAC:/ || !$opac && /^INTRANET:/;
last if $log;
}
$log =~ s/^(OPAC|INTRANET)://;