Koha/Logger.pm

   1 package Koha::Logger;
   2
   3 # Copyright 2015 ByWater Solutions
   4 # kyle@bywatersolutions.com
   5 #
   6 # This file is part of Koha.
   7 #
   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.
  12 #
  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.
  17 #
  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>.
  20
  21 =head1 NAME
  22
  23 Koha::Logger
  24
  25 =head1 SYNOPSIS
  26
  27     use Koha::Logger;
  28
  29     my $logger = Koha::Logger->get;
  30     $logger->warn( 'WARNING: Serious error encountered' );
  31     $logger->debug( 'I thought that this code was not used' );
  32
  33 =head1 FUNCTIONS
  34
  35 =cut
  36
  37 use Modern::Perl;
  38
  39 use Log::Log4perl;
  40 use Carp;
  41
  42 use C4::Context;
  43
  44 BEGIN {
  45     Log::Log4perl->wrapper_register(__PACKAGE__);
  46 }
  47
  48 =head2 get
  49
  50     Returns a logger object (based on log4perl).
  51     Category and interface hash parameter are optional.
  52     Normally, the category should follow the current package and the interface
  53     should be set correctly via C4::Context.
  54
  55 =cut
  56
  57 sub get {
  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 $l4pcat = $interface . '.' . $category;
  62
  63     my $init = _init();
  64     my $self = {};
  65     if ($init) {
  66         $self->{logger} = Log::Log4perl->get_logger($l4pcat);
  67         $self->{cat}    = $l4pcat;
  68         $self->{logs}   = $init if ref $init;
  69     }
  70     bless $self, $class;
  71     return $self;
  72 }
  73
  74 =head1 INTERNALS
  75
  76 =head2 AUTOLOAD
  77
  78     In order to prevent a crash when log4perl cannot write to Koha logfile,
  79     we check first before calling log4perl.
  80     If log4perl would add such a check, this would no longer be needed.
  81
  82 =cut
  83
  84 sub AUTOLOAD {
  85     my ( $self, $line ) = @_;
  86     my $method = $Koha::Logger::AUTOLOAD;
  87     $method =~ s/^Koha::Logger:://;
  88
  89     if ( $self->{logger}->can($method) ) {    #use log4perl
  90         return $self->{logger}->$method($line);
  91     }
  92     else {                                       # we should not really get here
  93         warn "ERROR: Unsupported method $method";
  94     }
  95     return;
  96 }
  97
  98 =head2 DESTROY
  99
 100     Dummy destroy to prevent call to AUTOLOAD
 101
 102 =cut
 103
 104 sub DESTROY { }
 105
 106 =head2 _init
 107
 108 =cut
 109
 110 sub _init {
 111
 112     my $log4perl_config =
 113           exists $ENV{"LOG4PERL_CONF"}
 114               && $ENV{'LOG4PERL_CONF'}
 115            && -s $ENV{"LOG4PERL_CONF"}
 116       # Check for web server level configuration first
 117       # In this case we ASSUME that you correctly arranged logfile
 118       # permissions. If not, log4perl will crash on you.
 119       ? $ENV{"LOG4PERL_CONF"}
 120       : C4::Context->config("log4perl_conf");
 121
 122     # This will explode with the relevant error message if something is wrong in the config file
 123     return Log::Log4perl->init_once($log4perl_config);
 124 }
 125
 126 =head2 debug_to_screen
 127
 128 Adds a new appender for the given logger that will log all DEBUG-and-higher messages to stderr.
 129 Useful for daemons.
 130
 131 =cut
 132
 133 sub debug_to_screen {
 134     my $self = shift;
 135
 136     return unless ( $self->{logger} );
 137
 138     my $appender = Log::Log4perl::Appender->new(
 139         'Log::Log4perl::Appender::Screen',
 140         stderr => 1,
 141         utf8 => 1,
 142         name => 'debug_to_screen' # We need a specific name to prevent duplicates
 143     );
 144
 145     $appender->threshold( $Log::Log4perl::DEBUG );
 146     $self->{logger}->add_appender( $appender );
 147     $self->{logger}->level( $Log::Log4perl::DEBUG );
 148 }
 149
 150 =head1 AUTHOR
 151
 152 Kyle M Hall, E<lt>kyle@bywatersolutions.comE<gt>
 153 Marcel de Rooy, Rijksmuseum
 154
 155 =cut
 156
 157 1;
 158
 159 __END__