Lines 52-68
BEGIN {
Link Here
|
52 |
|
52 |
|
53 |
sub get { |
53 |
sub get { |
54 |
my ( $class, $params ) = @_; |
54 |
my ( $class, $params ) = @_; |
55 |
my $interface = $params? ($params->{interface} || C4::Context->interface): |
55 |
my $interface = $params ? ( $params->{interface} || C4::Context->interface ) : C4::Context->interface; |
56 |
C4::Context->interface; |
56 |
my $category = $params ? ( $params->{category} || caller ) : caller; |
57 |
my $category = $params? ($params->{category} || caller): caller; |
57 |
my $l4pcat = $interface . '.' . $category; |
58 |
my $l4pcat= $interface. '.'. $category; |
|
|
59 |
|
58 |
|
60 |
my $init= _init(); |
59 |
my $init = _init(); |
61 |
my $self = {}; |
60 |
my $self = {}; |
62 |
if( $init ) { |
61 |
if ($init) { |
63 |
$self->{logger} = Log::Log4perl->get_logger( $l4pcat ); |
62 |
$self->{logger} = Log::Log4perl->get_logger($l4pcat); |
64 |
$self->{cat} = $l4pcat; |
63 |
$self->{cat} = $l4pcat; |
65 |
$self->{logs} = $init if ref $init; |
64 |
$self->{logs} = $init if ref $init; |
66 |
} |
65 |
} |
67 |
bless $self, $class; |
66 |
bless $self, $class; |
68 |
return $self; |
67 |
return $self; |
Lines 80-97
sub get {
Link Here
|
80 |
|
79 |
|
81 |
sub AUTOLOAD { |
80 |
sub AUTOLOAD { |
82 |
my ( $self, $line ) = @_; |
81 |
my ( $self, $line ) = @_; |
83 |
my $method= $Koha::Logger::AUTOLOAD; |
82 |
my $method = $Koha::Logger::AUTOLOAD; |
84 |
$method =~ s/^Koha::Logger:://; |
83 |
$method =~ s/^Koha::Logger:://; |
85 |
|
84 |
|
86 |
if( !exists $self->{logger} ) { |
85 |
if ( !exists $self->{logger} ) { |
|
|
86 |
|
87 |
#do not use log4perl; no print to stderr |
87 |
#do not use log4perl; no print to stderr |
88 |
} elsif( !$self->_recheck_logfile ) { |
88 |
} |
|
|
89 |
elsif ( !$self->_recheck_logfile ) { |
89 |
print STDERR "Log file not writable for log4perl\n"; |
90 |
print STDERR "Log file not writable for log4perl\n"; |
90 |
print STDERR "$method: $line\n" if $line; |
91 |
print STDERR "$method: $line\n" if $line; |
91 |
} elsif( $self->{logger}->can($method) ) { #use log4perl |
92 |
} |
92 |
$self->{logger}->$method( $line ); |
93 |
elsif ( $self->{logger}->can($method) ) { #use log4perl |
|
|
94 |
$self->{logger}->$method($line); |
93 |
return 1; |
95 |
return 1; |
94 |
} else { # we should not really get here |
96 |
} |
|
|
97 |
else { # we should not really get here |
95 |
print STDERR "ERROR: Unsupported method $method\n"; |
98 |
print STDERR "ERROR: Unsupported method $method\n"; |
96 |
} |
99 |
} |
97 |
return; |
100 |
return; |
Lines 103-109
sub AUTOLOAD {
Link Here
|
103 |
|
106 |
|
104 |
=cut |
107 |
=cut |
105 |
|
108 |
|
106 |
sub DESTROY {} |
109 |
sub DESTROY { } |
107 |
|
110 |
|
108 |
=head2 _init, _check_conf and _recheck_logfile |
111 |
=head2 _init, _check_conf and _recheck_logfile |
109 |
|
112 |
|
Lines 112-167
sub DESTROY {}
Link Here
|
112 |
sub _init { |
115 |
sub _init { |
113 |
my $rv; |
116 |
my $rv; |
114 |
if ( exists $ENV{"LOG4PERL_CONF"} and $ENV{'LOG4PERL_CONF'} and -s $ENV{"LOG4PERL_CONF"} ) { |
117 |
if ( exists $ENV{"LOG4PERL_CONF"} and $ENV{'LOG4PERL_CONF'} and -s $ENV{"LOG4PERL_CONF"} ) { |
|
|
118 |
|
115 |
# Check for web server level configuration first |
119 |
# Check for web server level configuration first |
116 |
# In this case we ASSUME that you correctly arranged logfile |
120 |
# In this case we ASSUME that you correctly arranged logfile |
117 |
# permissions. If not, log4perl will crash on you. |
121 |
# permissions. If not, log4perl will crash on you. |
118 |
# We will not parse apache files here. |
122 |
# We will not parse apache files here. |
119 |
Log::Log4perl->init_once( $ENV{"LOG4PERL_CONF"} ); |
123 |
Log::Log4perl->init_once( $ENV{"LOG4PERL_CONF"} ); |
120 |
} elsif ( C4::Context->config("log4perl_conf") ) { |
124 |
} |
|
|
125 |
elsif ( C4::Context->config("log4perl_conf") ) { |
126 |
|
121 |
# Now look in the koha conf file. We only check the permissions of |
127 |
# Now look in the koha conf file. We only check the permissions of |
122 |
# the default logfiles. For the rest, we again ASSUME that |
128 |
# the default logfiles. For the rest, we again ASSUME that |
123 |
# you arranged file permissions. |
129 |
# you arranged file permissions. |
124 |
my $conf= C4::Context->config("log4perl_conf"); |
130 |
my $conf = C4::Context->config("log4perl_conf"); |
125 |
if( $rv = _check_conf($conf) ) { |
131 |
if ( $rv = _check_conf($conf) ) { |
126 |
Log::Log4perl->init_once( $conf ); |
132 |
Log::Log4perl->init_once($conf); |
127 |
return $rv; |
133 |
return $rv; |
128 |
} else { |
134 |
} |
|
|
135 |
else { |
129 |
return 0; |
136 |
return 0; |
130 |
} |
137 |
} |
131 |
} else { |
|
|
132 |
# This means that you do not use log4perl currently. |
133 |
# We will not be forcing it. |
134 |
return 0; |
135 |
} |
138 |
} |
136 |
return 1; # if we make it here, log4perl did not crash :) |
139 |
else { |
|
|
140 |
# This means that you do not use log4perl currently. |
141 |
# We will not be forcing it. |
142 |
return 0; |
143 |
} |
144 |
return 1; # if we make it here, log4perl did not crash :) |
137 |
} |
145 |
} |
138 |
|
146 |
|
139 |
sub _check_conf { # check logfiles in log4perl config (at initialization) |
147 |
sub _check_conf { # check logfiles in log4perl config (at initialization) |
140 |
my $file = shift; |
148 |
my $file = shift; |
141 |
return if !-r $file; |
149 |
return if !-r $file; |
142 |
open my $fh, '<', $file; |
150 |
open my $fh, '<', $file; |
143 |
my @lines = <$fh>; |
151 |
my @lines = <$fh>; |
144 |
close $fh; |
152 |
close $fh; |
145 |
my @logs; |
153 |
my @logs; |
146 |
foreach my $l ( @lines ) { |
154 |
foreach my $l (@lines) { |
147 |
if( $l =~ /(OPAC|INTRANET)\.filename\s*=\s*(.*)\s*$/i ) { |
155 |
if ( $l =~ /(OPAC|INTRANET)\.filename\s*=\s*(.*)\s*$/i ) { |
148 |
# we only check the two default logfiles, skipping additional ones |
156 |
|
|
|
157 |
# we only check the two default logfiles, skipping additional ones |
149 |
return if !-w $2; |
158 |
return if !-w $2; |
150 |
push @logs, $1.':'.$2; |
159 |
push @logs, $1 . ':' . $2; |
151 |
} |
160 |
} |
152 |
} |
161 |
} |
153 |
return if !@logs; # we should find one |
162 |
return if !@logs; # we should find one |
154 |
return \@logs; |
163 |
return \@logs; |
155 |
} |
164 |
} |
156 |
|
165 |
|
157 |
sub _recheck_logfile { # recheck saved logfile when logging message |
166 |
sub _recheck_logfile { # recheck saved logfile when logging message |
158 |
my $self = shift; |
167 |
my $self = shift; |
159 |
|
168 |
|
160 |
return 1 if !exists $self->{logs}; # remember? your own responsibility |
169 |
return 1 if !exists $self->{logs}; # remember? your own responsibility |
161 |
my $opac= $self->{cat}=~ /^OPAC/; |
170 |
my $opac = $self->{cat} =~ /^OPAC/; |
162 |
my $log; |
171 |
my $log; |
163 |
foreach( @{$self->{logs}} ) { |
172 |
foreach ( @{ $self->{logs} } ) { |
164 |
$log=$_ if $opac && /^OPAC:/ || !$opac && /^INTRANET:/; |
173 |
$log = $_ if $opac && /^OPAC:/ || !$opac && /^INTRANET:/; |
165 |
last if $log; |
174 |
last if $log; |
166 |
} |
175 |
} |
167 |
$log =~ s/^(OPAC|INTRANET)://; |
176 |
$log =~ s/^(OPAC|INTRANET)://; |
168 |
- |
|
|