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.
54 If the category should not be prefixed if plack, set the param 'prefix' to 0.
58 my ( $class, $params ) = @_;
59 my $interface = $params ? ( $params->{interface} || C4::Context->interface ) : C4::Context->interface;
60 my $category = $params ? ( $params->{category} || caller ) : caller;
61 my $prefix = $params->{prefix} // 1;
63 my $l4pcat = ( ( $prefix && C4::Context->psgi_env ) ? 'plack-' : q{} ) . $interface . '.' . $category;
68 $self->{logger} = Log::Log4perl->get_logger($l4pcat);
69 $self->{cat} = $l4pcat;
70 $self->{logs} = $init if ref $init;
78 my $foo = $logger->put_mdc('foo', $foo );
80 put_mdc sets global thread specific data that can be access later when generating log lines
81 via the "%X{key}" placeholder in Log::Log4perl::Layout::PatternLayouts.
86 my ( $self, $key, $value ) = @_;
88 Log::Log4perl::MDC->put( $key, $value );
93 my $foo = $logger->get_mdc('foo');
95 Retrieves the stored mdc value from the stored map.
100 my ( $self, $key ) = @_;
102 return Log::Log4perl::MDC->get( $key );
107 $logger->clear_mdc();
109 Removes *all* stored key/value pairs from the MDC map.
114 my ( $self, $key ) = @_;
116 return Log::Log4perl::MDC->remove( $key );
123 In order to prevent a crash when log4perl cannot write to Koha logfile,
124 we check first before calling log4perl.
125 If log4perl would add such a check, this would no longer be needed.
130 my ( $self, $line ) = @_;
131 my $method = $Koha::Logger::AUTOLOAD;
132 $method =~ s/^Koha::Logger:://;
134 if ( $self->{logger}->can($method) ) { #use log4perl
135 return $self->{logger}->$method($line);
137 else { # we should not really get here
138 warn "ERROR: Unsupported method $method";
145 Dummy destroy to prevent call to AUTOLOAD
157 my $log4perl_config =
158 exists $ENV{"LOG4PERL_CONF"}
159 && $ENV{'LOG4PERL_CONF'}
160 && -s $ENV{"LOG4PERL_CONF"}
161 # Check for web server level configuration first
162 # In this case we ASSUME that you correctly arranged logfile
163 # permissions. If not, log4perl will crash on you.
164 ? $ENV{"LOG4PERL_CONF"}
165 : C4::Context->config("log4perl_conf");
167 # This will explode with the relevant error message if something is wrong in the config file
168 return Log::Log4perl->init_once($log4perl_config);
171 =head2 debug_to_screen
173 Adds a new appender for the given logger that will log all DEBUG-and-higher messages to stderr.
178 sub debug_to_screen {
181 return unless ( $self->{logger} );
183 my $appender = Log::Log4perl::Appender->new(
184 'Log::Log4perl::Appender::Screen',
187 name => 'debug_to_screen' # We need a specific name to prevent duplicates
190 $appender->threshold( $Log::Log4perl::DEBUG );
191 $self->{logger}->add_appender( $appender );
192 $self->{logger}->level( $Log::Log4perl::DEBUG );
197 Mojolicous 8.23 added a "context" method, which Mojolicious will die
198 on if it's missing from the logger.
200 Note: We are just preventing a crash here not returning a new context logger.
205 my ( $self, @context ) = @_;
206 $self->{context} = \@context;
212 Similar to above, Mojolicious has a "history" method and will die
213 on it if it's missing from the logger.
215 Note: We are just preventing a crash here not returning a new history logger.
220 my ( $self, @history) = @_;
222 $self->{history} = \@history;
224 return $self->{history} || [];
229 Kyle M Hall, E<lt>kyle@bywatersolutions.comE<gt>
230 Marcel de Rooy, Rijksmuseum