|
Lines 39-92
use C4::Context;
Link Here
|
| 39 |
|
39 |
|
| 40 |
BEGIN { |
40 |
BEGIN { |
| 41 |
Log::Log4perl->wrapper_register(__PACKAGE__); |
41 |
Log::Log4perl->wrapper_register(__PACKAGE__); |
| 42 |
|
|
|
| 43 |
if ( exists $ENV{"LOG4PERL_CONF"} and $ENV{'LOG4PERL_CONF'} and -s $ENV{"LOG4PERL_CONF"} ) { |
| 44 |
# Check for web server level configuration first |
| 45 |
Log::Log4perl->init_once( $ENV{"LOG4PERL_CONF"} ); |
| 46 |
} |
| 47 |
elsif ( C4::Context->config("log4perl_conf") ) { |
| 48 |
# If no web server level config exists, look in the koha conf file for one |
| 49 |
Log::Log4perl->init_once( C4::Context->config("log4perl_conf") ); |
| 50 |
} else { |
| 51 |
my $logdir = C4::Context->config("logdir"); |
| 52 |
my $conf = qq( |
| 53 |
log4perl.logger.intranet = WARN, INTRANET |
| 54 |
log4perl.appender.INTRANET=Log::Log4perl::Appender::File |
| 55 |
log4perl.appender.INTRANET.filename=$logdir/intranet-error.log |
| 56 |
log4perl.appender.INTRANET.mode=append |
| 57 |
log4perl.appender.INTRANET.layout=PatternLayout |
| 58 |
log4perl.appender.INTRANET.layout.ConversionPattern=[%d] [%p] %m %l %n |
| 59 |
|
| 60 |
log4perl.logger.opac = WARN, OPAC |
| 61 |
log4perl.appender.OPAC=Log::Log4perl::Appender::File |
| 62 |
log4perl.appender.OPAC.filename=$logdir/opac-error.log |
| 63 |
log4perl.appender.OPAC.mode=append |
| 64 |
log4perl.appender.OPAC.layout=PatternLayout |
| 65 |
log4perl.appender.OPAC.layout.ConversionPattern=[%d] [%p] %m %l %n |
| 66 |
); |
| 67 |
Log::Log4perl->init_once(\$conf); |
| 68 |
} |
| 69 |
} |
42 |
} |
| 70 |
|
43 |
|
| 71 |
=head2 get |
44 |
=head2 get |
| 72 |
|
45 |
|
| 73 |
Returns a log4perl object. |
46 |
Returns a logger object (based on log4perl). |
| 74 |
Category and interface parameter are optional. |
47 |
Category and interface hash parameter are optional. |
| 75 |
Normally, the category should follow the current package and the interface |
48 |
Normally, the category should follow the current package and the interface |
| 76 |
should be set correctly via C4::Context. |
49 |
should be set correctly via C4::Context. |
| 77 |
|
50 |
|
| 78 |
=cut |
51 |
=cut |
| 79 |
|
52 |
|
| 80 |
sub get { |
53 |
sub get { |
| 81 |
my ( $class, $category, $interface ) = @_; |
54 |
my ( $class, $params ) = @_; |
| 82 |
$interface ||= C4::Context->interface(); |
55 |
my $interface = $params? ($params->{interface} || C4::Context->interface): |
| 83 |
$category = caller if !$category; |
56 |
C4::Context->interface; |
| 84 |
return Log::Log4perl->get_logger( $interface. '.'. $category ); |
57 |
my $category = $params? ($params->{category} || caller): caller; |
|
|
58 |
my $l4pcat= $interface. '.'. $category; |
| 59 |
|
| 60 |
my $init= _init(); |
| 61 |
my $self = {}; |
| 62 |
if( $init ) { |
| 63 |
$self->{logger} = Log::Log4perl->get_logger( $l4pcat ); |
| 64 |
$self->{cat} = $l4pcat; |
| 65 |
$self->{logs} = $init if ref $init; |
| 66 |
} |
| 67 |
bless $self, $class; |
| 68 |
return $self; |
| 69 |
} |
| 70 |
|
| 71 |
=head1 INTERNALS |
| 72 |
|
| 73 |
=head2 AUTOLOAD |
| 74 |
|
| 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. |
| 78 |
|
| 79 |
=cut |
| 80 |
|
| 81 |
sub AUTOLOAD { |
| 82 |
my ( $self, $line ) = @_; |
| 83 |
my $method= $Koha::Logger::AUTOLOAD; |
| 84 |
$method =~ s/^Koha::Logger:://; |
| 85 |
|
| 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 ); |
| 93 |
return 1; |
| 94 |
} else { # we should not really get here |
| 95 |
print STDERR "ERROR: Unsupported method $method\n"; |
| 96 |
} |
| 97 |
return; |
| 98 |
} |
| 99 |
|
| 100 |
=head2 DESTROY |
| 101 |
|
| 102 |
Dummy destroy to prevent call to AUTOLOAD |
| 103 |
|
| 104 |
=cut |
| 105 |
|
| 106 |
sub DESTROY {} |
| 107 |
|
| 108 |
=head2 _init, _check_conf and _recheck_logfile |
| 109 |
|
| 110 |
=cut |
| 111 |
|
| 112 |
sub _init { |
| 113 |
my $rv; |
| 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 ); |
| 127 |
return $rv; |
| 128 |
} else { |
| 129 |
return 0; |
| 130 |
} |
| 131 |
} else { |
| 132 |
# This means that you do not use log4perl currently. |
| 133 |
# We will not be forcing it. |
| 134 |
return 0; |
| 135 |
} |
| 136 |
return 1; # if we make it here, log4perl did not crash :) |
| 137 |
} |
| 138 |
|
| 139 |
sub _check_conf { # check logfiles in log4perl config (at initialization) |
| 140 |
my $file = shift; |
| 141 |
return if !-r $file; |
| 142 |
open my $fh, '<', $file; |
| 143 |
my @lines = <$fh>; |
| 144 |
close $fh; |
| 145 |
my @logs; |
| 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 |
| 149 |
return if !-w $2; |
| 150 |
push @logs, $1.':'.$2; |
| 151 |
} |
| 152 |
} |
| 153 |
return if !@logs; # we should find one |
| 154 |
return \@logs; |
| 155 |
} |
| 156 |
|
| 157 |
sub _recheck_logfile { # recheck saved logfile when logging message |
| 158 |
my $self = shift; |
| 159 |
|
| 160 |
return 1 if !exists $self->{logs}; # remember? your own responsibility |
| 161 |
my $opac= $self->{cat}=~ /^OPAC/; |
| 162 |
my $log; |
| 163 |
foreach( @{$self->{logs}} ) { |
| 164 |
$log=$_ if $opac && /^OPAC:/ || !$opac && /^INTRANET:/; |
| 165 |
last if $log; |
| 166 |
} |
| 167 |
$log =~ s/^(OPAC|INTRANET)://; |
| 168 |
return -w $log; |
| 85 |
} |
169 |
} |
| 86 |
|
170 |
|
| 87 |
=head1 AUTHOR |
171 |
=head1 AUTHOR |
| 88 |
|
172 |
|
| 89 |
Kyle M Hall, E<lt>kyle@bywatersolutions.comE<gt> |
173 |
Kyle M Hall, E<lt>kyle@bywatersolutions.comE<gt> |
|
|
174 |
Marcel de Rooy, Rijksmuseum |
| 90 |
|
175 |
|
| 91 |
=cut |
176 |
=cut |
| 92 |
|
177 |
|
| 93 |
- |
|
|