#
# This file is part of Koha.
#
-# Koha is free software; you can redistribute it and/or modify it under the
-# terms of the GNU General Public License as published by the Free Software
-# Foundation; either version 3 of the License, or (at your option) any later
-# version.
+# Koha is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
#
-# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
-# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
-# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+# Koha is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
#
-# You should have received a copy of the GNU General Public License along
-# with Koha; if not, write to the Free Software Foundation, Inc.,
-# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+# You should have received a copy of the GNU General Public License
+# along with Koha; if not, see <http://www.gnu.org/licenses>.
=head1 NAME
-Koha::Log
+Koha::Logger
=head1 SYNOPSIS
- use Koha::Log;
+ use Koha::Logger;
+
+ my $logger = Koha::Logger->get;
+ $logger->warn( 'WARNING: Serious error encountered' );
+ $logger->debug( 'I thought that this code was not used' );
=head1 FUNCTIONS
use Modern::Perl;
use Log::Log4perl;
-use Carp;
use C4::Context;
return $self;
}
+=head2 put_mdc
+
+my $foo = $logger->put_mdc('foo', $foo );
+
+put_mdc sets global thread specific data that can be access later when generating log lines
+via the "%X{key}" placeholder in Log::Log4perl::Layout::PatternLayouts.
+
+=cut
+
+sub put_mdc {
+ my ( $self, $key, $value ) = @_;
+
+ Log::Log4perl::MDC->put( $key, $value );
+}
+
+=head2 get_mdc
+
+my $foo = $logger->get_mdc('foo');
+
+Retrieves the stored mdc value from the stored map.
+
+=cut
+
+sub get_mdc {
+ my ( $self, $key ) = @_;
+
+ return Log::Log4perl::MDC->get( $key );
+}
+
+=head2 clear_mdc
+
+$logger->clear_mdc();
+
+Removes *all* stored key/value pairs from the MDC map.
+
+=cut
+
+sub clear_mdc {
+ my ( $self, $key ) = @_;
+
+ return Log::Log4perl::MDC->remove( $key );
+}
+
=head1 INTERNALS
=head2 AUTOLOAD
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;
+ if ( $self->{logger}->can($method) ) { #use log4perl
+ return $self->{logger}->$method($line);
}
else { # we should not really get here
- print STDERR "ERROR: Unsupported method $method\n";
+ warn "ERROR: Unsupported method $method";
}
return;
}
sub DESTROY { }
-=head2 _init, _check_conf and _recheck_logfile
+=head2 _init
=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;
+ my $log4perl_config =
+ exists $ENV{"LOG4PERL_CONF"}
+ && $ENV{'LOG4PERL_CONF'}
+ && -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.
+ ? $ENV{"LOG4PERL_CONF"}
+ : C4::Context->config("log4perl_conf");
+
+ # This will explode with the relevant error message if something is wrong in the config file
+ return Log::Log4perl->init_once($log4perl_config);
}
-sub _recheck_logfile { # recheck saved logfile when logging message
+=head2 debug_to_screen
+
+Adds a new appender for the given logger that will log all DEBUG-and-higher messages to stderr.
+Useful for daemons.
+
+=cut
+
+sub debug_to_screen {
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;
+ return unless ( $self->{logger} );
+
+ my $appender = Log::Log4perl::Appender->new(
+ 'Log::Log4perl::Appender::Screen',
+ stderr => 1,
+ utf8 => 1,
+ name => 'debug_to_screen' # We need a specific name to prevent duplicates
+ );
+
+ $appender->threshold( $Log::Log4perl::DEBUG );
+ $self->{logger}->add_appender( $appender );
+ $self->{logger}->level( $Log::Log4perl::DEBUG );
}
=head1 AUTHOR
projects / srvgit / blobdiff