3 # Copyright 2015 ByWater Solutions
4 # kyle@bywatersolutions.com
6 # This file is part of Koha.
8 # Koha is free software; you can redistribute it and/or modify it
9 # under the terms of the GNU General Public License as published by
10 # the Free Software Foundation; either version 3 of the License, or
11 # (at your option) any later version.
13 # Koha is distributed in the hope that it will be useful, but
14 # WITHOUT ANY WARRANTY; without even the implied warranty of
15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 # GNU General Public License for more details.
18 # You should have received a copy of the GNU General Public License
19 # along with Koha; if not, see <http://www.gnu.org/licenses>.
29 my $logger = Koha::Logger->get;
30 $logger->warn( 'WARNING: Serious error encountered' );
31 $logger->debug( 'I thought that this code was not used' );
44 Log::Log4perl->wrapper_register(__PACKAGE__);
49 Returns a logger object (based on log4perl).
50 Category and interface hash parameter are optional.
51 Normally, the category should follow the current package and the interface
52 should be set correctly via C4::Context.
57 my ( $class, $params ) = @_;
58 my $interface = $params ? ( $params->{interface} || C4::Context->interface ) : C4::Context->interface;
59 my $category = $params ? ( $params->{category} || caller ) : caller;
60 my $l4pcat = $interface . '.' . $category;
65 $self->{logger} = Log::Log4perl->get_logger($l4pcat);
66 $self->{cat} = $l4pcat;
67 $self->{logs} = $init if ref $init;
75 my $foo = $logger->put_mdc('foo', $foo );
77 put_mdc sets global thread specific data that can be access later when generating log lines
78 via the "%X{key}" placeholder in Log::Log4perl::Layout::PatternLayouts.
83 my ( $self, $key, $value ) = @_;
85 Log::Log4perl::MDC->put( $key, $value );
90 my $foo = $logger->get_mdc('foo');
92 Retrieves the stored mdc value from the stored map.
97 my ( $self, $key ) = @_;
99 return Log::Log4perl::MDC->get( $key );
104 $logger->clear_mdc();
106 Removes *all* stored key/value pairs from the MDC map.
111 my ( $self, $key ) = @_;
113 return Log::Log4perl::MDC->remove( $key );
120 In order to prevent a crash when log4perl cannot write to Koha logfile,
121 we check first before calling log4perl.
122 If log4perl would add such a check, this would no longer be needed.
127 my ( $self, $line ) = @_;
128 my $method = $Koha::Logger::AUTOLOAD;
129 $method =~ s/^Koha::Logger:://;
131 if ( $self->{logger}->can($method) ) { #use log4perl
132 return $self->{logger}->$method($line);
134 else { # we should not really get here
135 warn "ERROR: Unsupported method $method";
142 Dummy destroy to prevent call to AUTOLOAD
154 my $log4perl_config =
155 exists $ENV{"LOG4PERL_CONF"}
156 && $ENV{'LOG4PERL_CONF'}
157 && -s $ENV{"LOG4PERL_CONF"}
158 # Check for web server level configuration first
159 # In this case we ASSUME that you correctly arranged logfile
160 # permissions. If not, log4perl will crash on you.
161 ? $ENV{"LOG4PERL_CONF"}
162 : C4::Context->config("log4perl_conf");
164 # This will explode with the relevant error message if something is wrong in the config file
165 return Log::Log4perl->init_once($log4perl_config);
168 =head2 debug_to_screen
170 Adds a new appender for the given logger that will log all DEBUG-and-higher messages to stderr.
175 sub debug_to_screen {
178 return unless ( $self->{logger} );
180 my $appender = Log::Log4perl::Appender->new(
181 'Log::Log4perl::Appender::Screen',
184 name => 'debug_to_screen' # We need a specific name to prevent duplicates
187 $appender->threshold( $Log::Log4perl::DEBUG );
188 $self->{logger}->add_appender( $appender );
189 $self->{logger}->level( $Log::Log4perl::DEBUG );
194 Kyle M Hall, E<lt>kyle@bywatersolutions.comE<gt>
195 Marcel de Rooy, Rijksmuseum