#
# 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;
BEGIN {
Log::Log4perl->wrapper_register(__PACKAGE__);
-
- if ( exists $ENV{"LOG4PERL_CONF"} and $ENV{'LOG4PERL_CONF'} and -s $ENV{"LOG4PERL_CONF"} ) {
- # Check for web server level configuration first
- Log::Log4perl->init_once( $ENV{"LOG4PERL_CONF"} );
- }
- elsif ( C4::Context->config("log4perl_conf") ) {
- # If no web server level config exists, look in the koha conf file for one
- Log::Log4perl->init_once( C4::Context->config("log4perl_conf") );
- } else {
- my $logdir = C4::Context->config("logdir");
- my $conf = qq(
- log4perl.logger.intranet = WARN, INTRANET
- log4perl.appender.INTRANET=Log::Log4perl::Appender::File
- log4perl.appender.INTRANET.filename=$logdir/intranet-error.log
- log4perl.appender.INTRANET.mode=append
- log4perl.appender.INTRANET.layout=PatternLayout
- log4perl.appender.INTRANET.layout.ConversionPattern=[%d] [%p] %m %l %n
-
- log4perl.logger.opac = WARN, OPAC
- log4perl.appender.OPAC=Log::Log4perl::Appender::File
- log4perl.appender.OPAC.filename=$logdir/opac-error.log
- log4perl.appender.OPAC.mode=append
- log4perl.appender.OPAC.layout=PatternLayout
- log4perl.appender.OPAC.layout.ConversionPattern=[%d] [%p] %m %l %n
- );
- Log::Log4perl->init_once(\$conf);
- }
}
=head2 get
- Returns a log4perl object.
- Category and interface parameter are optional.
+ Returns a logger object (based on log4perl).
+ Category and interface hash parameter are optional.
Normally, the category should follow the current package and the interface
should be set correctly via C4::Context.
=cut
sub get {
- my ( $class, $category, $interface ) = @_;
- $interface ||= C4::Context->interface();
- $category = caller if !$category;
- return Log::Log4perl->get_logger( $interface. '.'. $category );
+ my ( $class, $params ) = @_;
+ my $interface = $params ? ( $params->{interface} || C4::Context->interface ) : C4::Context->interface;
+ my $category = $params ? ( $params->{category} || caller ) : caller;
+ my $l4pcat = ( C4::Context->psgi_env ? 'plack-' : q{} ) . $interface . '.' . $category;
+
+ my $init = _init();
+ my $self = {};
+ if ($init) {
+ $self->{logger} = Log::Log4perl->get_logger($l4pcat);
+ $self->{cat} = $l4pcat;
+ $self->{logs} = $init if ref $init;
+ }
+ bless $self, $class;
+ 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
+
+ In order to prevent a crash when log4perl cannot write to Koha logfile,
+ we check first before calling log4perl.
+ If log4perl would add such a check, this would no longer be needed.
+
+=cut
+
+sub AUTOLOAD {
+ my ( $self, $line ) = @_;
+ my $method = $Koha::Logger::AUTOLOAD;
+ $method =~ s/^Koha::Logger:://;
+
+ if ( $self->{logger}->can($method) ) { #use log4perl
+ return $self->{logger}->$method($line);
+ }
+ else { # we should not really get here
+ warn "ERROR: Unsupported method $method";
+ }
+ return;
+}
+
+=head2 DESTROY
+
+ Dummy destroy to prevent call to AUTOLOAD
+
+=cut
+
+sub DESTROY { }
+
+=head2 _init
+
+=cut
+
+sub _init {
+
+ 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);
+}
+
+=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 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
Kyle M Hall, E<lt>kyle@bywatersolutions.comE<gt>
+Marcel de Rooy, Rijksmuseum
=cut
projects / koha-ffzg.git / blobdiff