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
  41 use C4::Context;
  42
  43 BEGIN {
  44     Log::Log4perl->wrapper_register(__PACKAGE__);
  45 }
  46
  47 =head2 get
  48
  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.
  53
  54 =cut
  55
  56 sub get {
  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;
  61
  62     my $init = _init();
  63     my $self = {};
  64     if ($init) {
  65         $self->{logger} = Log::Log4perl->get_logger($l4pcat);
  66         $self->{cat}    = $l4pcat;
  67         $self->{logs}   = $init if ref $init;
  68     }
  69     bless $self, $class;
  70     return $self;
  71 }
  72
  73 =head1 INTERNALS
  74
  75 =head2 AUTOLOAD
  76
  77     In order to prevent a crash when log4perl cannot write to Koha logfile,
  78     we check first before calling log4perl.
  79     If log4perl would add such a check, this would no longer be needed.
  80
  81 =cut
  82
  83 sub AUTOLOAD {
  84     my ( $self, $line ) = @_;
  85     my $method = $Koha::Logger::AUTOLOAD;
  86     $method =~ s/^Koha::Logger:://;
  87
  88     if ( $self->{logger}->can($method) ) {    #use log4perl
  89         return $self->{logger}->$method($line);
  90     }
  91     else {                                       # we should not really get here
  92         warn "ERROR: Unsupported method $method";
  93     }
  94     return;
  95 }
  96
  97 =head2 DESTROY
  98
  99     Dummy destroy to prevent call to AUTOLOAD
 100
 101 =cut
 102
 103 sub DESTROY { }
 104
 105 =head2 _init
 106
 107 =cut
 108
 109 sub _init {
 110
 111     my $log4perl_config =
 112           exists $ENV{"LOG4PERL_CONF"}
 113               && $ENV{'LOG4PERL_CONF'}
 114            && -s $ENV{"LOG4PERL_CONF"}
 115       # Check for web server level configuration first
 116       # In this case we ASSUME that you correctly arranged logfile
 117       # permissions. If not, log4perl will crash on you.
 118       ? $ENV{"LOG4PERL_CONF"}
 119       : C4::Context->config("log4perl_conf");
 120
 121     # This will explode with the relevant error message if something is wrong in the config file
 122     return Log::Log4perl->init_once($log4perl_config);
 123 }
 124
 125 =head2 debug_to_screen
 126
 127 Adds a new appender for the given logger that will log all DEBUG-and-higher messages to stderr.
 128 Useful for daemons.
 129
 130 =cut
 131
 132 sub debug_to_screen {
 133     my $self = shift;
 134
 135     return unless ( $self->{logger} );
 136
 137     my $appender = Log::Log4perl::Appender->new(
 138         'Log::Log4perl::Appender::Screen',
 139         stderr => 1,
 140         utf8 => 1,
 141         name => 'debug_to_screen' # We need a specific name to prevent duplicates
 142     );
 143
 144     $appender->threshold( $Log::Log4perl::DEBUG );
 145     $self->{logger}->add_appender( $appender );
 146     $self->{logger}->level( $Log::Log4perl::DEBUG );
 147 }
 148
 149 =head1 AUTHOR
 150
 151 Kyle M Hall, E<lt>kyle@bywatersolutions.comE<gt>
 152 Marcel de Rooy, Rijksmuseum
 153
 154 =cut
 155
 156 1;
 157
 158 __END__