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 |
- |
|
|