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 under the
   9 # terms of the GNU General Public License as published by the Free Software
  10 # Foundation; either version 3 of the License, or (at your option) any later
  11 # version.
  12 #
  13 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  14 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  15 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License along
  18 # with Koha; if not, write to the Free Software Foundation, Inc.,
  19 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  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 ( !exists $self->{logger} ) {
  90
  91         #do not use log4perl; no print to stderr
  92     }
  93     elsif ( !$self->_recheck_logfile ) {
  94         warn "Log file not writable for log4perl";
  95         warn "$method: $line" if $line;
  96     }
  97     elsif ( $self->{logger}->can($method) ) {    #use log4perl
  98         $self->{logger}->$method($line);
  99         return 1;
 100     }
 101     else {                                       # we should not really get here
 102         warn "ERROR: Unsupported method $method";
 103     }
 104     return;
 105 }
 106
 107 =head2 DESTROY
 108
 109     Dummy destroy to prevent call to AUTOLOAD
 110
 111 =cut
 112
 113 sub DESTROY { }
 114
 115 =head2 _init, _check_conf and _recheck_logfile
 116
 117 =cut
 118
 119 sub _init {
 120     my $rv;
 121     if ( exists $ENV{"LOG4PERL_CONF"} and $ENV{'LOG4PERL_CONF'} and -s $ENV{"LOG4PERL_CONF"} ) {
 122
 123         # Check for web server level configuration first
 124         # In this case we ASSUME that you correctly arranged logfile
 125         # permissions. If not, log4perl will crash on you.
 126         # We will not parse apache files here.
 127         Log::Log4perl->init_once( $ENV{"LOG4PERL_CONF"} );
 128     }
 129     elsif ( C4::Context->config("log4perl_conf") ) {
 130
 131         # Now look in the koha conf file. We only check the permissions of
 132         # the default logfiles. For the rest, we again ASSUME that
 133         # you arranged file permissions.
 134         my $conf = C4::Context->config("log4perl_conf");
 135         if ( $rv = _check_conf($conf) ) {
 136             Log::Log4perl->init_once($conf);
 137             return $rv;
 138         }
 139         else {
 140             return 0;
 141         }
 142     }
 143     else {
 144         # This means that you do not use log4perl currently.
 145         # We will not be forcing it.
 146         return 0;
 147     }
 148     return 1;    # if we make it here, log4perl did not crash :)
 149 }
 150
 151 sub _check_conf {    # check logfiles in log4perl config (at initialization)
 152     my $file = shift;
 153     return if !-r $file;
 154     open my $fh, '<', $file;
 155     my @lines = <$fh>;
 156     close $fh;
 157     my @logs;
 158     foreach my $l (@lines) {
 159         if ( $l =~ /(OPAC|INTRANET)\.filename\s*=\s*(.*)\s*$/i ) {
 160
 161             # we only check the two default logfiles, skipping additional ones
 162             return if !-w $2;
 163             push @logs, $1 . ':' . $2;
 164         }
 165     }
 166     return if !@logs;    # we should find one
 167     return \@logs;
 168 }
 169
 170 sub _recheck_logfile {    # recheck saved logfile when logging message
 171     my $self = shift;
 172
 173     return 1 if !exists $self->{logs};    # remember? your own responsibility
 174     my $opac = $self->{cat} =~ /^OPAC/;
 175     my $log;
 176     foreach ( @{ $self->{logs} } ) {
 177         $log = $_ if $opac && /^OPAC:/ || !$opac && /^INTRANET:/;
 178         last if $log;
 179     }
 180     $log =~ s/^(OPAC|INTRANET)://;
 181     return -w $log;
 182 }
 183
 184 =head2 debug_to_screen
 185
 186 Adds a new appender for the given logger that will log all DEBUG-and-higher messages to stderr.
 187 Useful for daemons.
 188
 189 =cut
 190
 191 sub debug_to_screen {
 192     my $self = shift;
 193
 194     return unless ( $self->{logger} );
 195
 196     my $appender = Log::Log4perl::Appender->new(
 197         'Log::Log4perl::Appender::Screen',
 198         stderr => 1,
 199         utf8 => 1,
 200         name => 'debug_to_screen' # We need a specific name to prevent duplicates
 201     );
 202
 203     $appender->threshold( $Log::Log4perl::DEBUG );
 204     $self->{logger}->add_appender( $appender );
 205     $self->{logger}->level( $Log::Log4perl::DEBUG );
 206 }
 207
 208 =head1 AUTHOR
 209
 210 Kyle M Hall, E<lt>kyle@bywatersolutions.comE<gt>
 211 Marcel de Rooy, Rijksmuseum
 212
 213 =cut
 214
 215 1;
 216
 217 __END__