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::Log
  24
  25 =head1 SYNOPSIS
  26
  27   use Koha::Log;
  28
  29 =head1 FUNCTIONS
  30
  31 =cut
  32
  33 use Modern::Perl;
  34
  35 use Log::Log4perl;
  36 use Carp;
  37
  38 use C4::Context;
  39
  40 BEGIN {
  41     Log::Log4perl->wrapper_register(__PACKAGE__);
  42 }
  43
  44 =head2 get
  45
  46     Returns a logger object (based on log4perl).
  47     Category and interface hash parameter are optional.
  48     Normally, the category should follow the current package and the interface
  49     should be set correctly via C4::Context.
  50
  51 =cut
  52
  53 sub get {
  54     my ( $class, $params ) = @_;
  55     my $interface = $params ? ( $params->{interface} || C4::Context->interface ) : C4::Context->interface;
  56     my $category = $params ? ( $params->{category} || caller ) : caller;
  57     my $l4pcat = $interface . '.' . $category;
  58
  59     my $init = _init();
  60     my $self = {};
  61     if ($init) {
  62         $self->{logger} = Log::Log4perl->get_logger($l4pcat);
  63         $self->{cat}    = $l4pcat;
  64         $self->{logs}   = $init if ref $init;
  65     }
  66     bless $self, $class;
  67     return $self;
  68 }
  69
  70 =head1 INTERNALS
  71
  72 =head2 AUTOLOAD
  73
  74     In order to prevent a crash when log4perl cannot write to Koha logfile,
  75     we check first before calling log4perl.
  76     If log4perl would add such a check, this would no longer be needed.
  77
  78 =cut
  79
  80 sub AUTOLOAD {
  81     my ( $self, $line ) = @_;
  82     my $method = $Koha::Logger::AUTOLOAD;
  83     $method =~ s/^Koha::Logger:://;
  84
  85     if ( !exists $self->{logger} ) {
  86
  87         #do not use log4perl; no print to stderr
  88     }
  89     elsif ( !$self->_recheck_logfile ) {
  90         warn "Log file not writable for log4perl";
  91         warn "$method: $line" if $line;
  92     }
  93     elsif ( $self->{logger}->can($method) ) {    #use log4perl
  94         $self->{logger}->$method($line);
  95         return 1;
  96     }
  97     else {                                       # we should not really get here
  98         warn "ERROR: Unsupported method $method";
  99     }
 100     return;
 101 }
 102
 103 =head2 DESTROY
 104
 105     Dummy destroy to prevent call to AUTOLOAD
 106
 107 =cut
 108
 109 sub DESTROY { }
 110
 111 =head2 _init, _check_conf and _recheck_logfile
 112
 113 =cut
 114
 115 sub _init {
 116     my $rv;
 117     if ( exists $ENV{"LOG4PERL_CONF"} and $ENV{'LOG4PERL_CONF'} and -s $ENV{"LOG4PERL_CONF"} ) {
 118
 119         # Check for web server level configuration first
 120         # In this case we ASSUME that you correctly arranged logfile
 121         # permissions. If not, log4perl will crash on you.
 122         # We will not parse apache files here.
 123         Log::Log4perl->init_once( $ENV{"LOG4PERL_CONF"} );
 124     }
 125     elsif ( C4::Context->config("log4perl_conf") ) {
 126
 127         # Now look in the koha conf file. We only check the permissions of
 128         # the default logfiles. For the rest, we again ASSUME that
 129         # you arranged file permissions.
 130         my $conf = C4::Context->config("log4perl_conf");
 131         if ( $rv = _check_conf($conf) ) {
 132             Log::Log4perl->init_once($conf);
 133             return $rv;
 134         }
 135         else {
 136             return 0;
 137         }
 138     }
 139     else {
 140         # This means that you do not use log4perl currently.
 141         # We will not be forcing it.
 142         return 0;
 143     }
 144     return 1;    # if we make it here, log4perl did not crash :)
 145 }
 146
 147 sub _check_conf {    # check logfiles in log4perl config (at initialization)
 148     my $file = shift;
 149     return if !-r $file;
 150     open my $fh, '<', $file;
 151     my @lines = <$fh>;
 152     close $fh;
 153     my @logs;
 154     foreach my $l (@lines) {
 155         if ( $l =~ /(OPAC|INTRANET)\.filename\s*=\s*(.*)\s*$/i ) {
 156
 157             # we only check the two default logfiles, skipping additional ones
 158             return if !-w $2;
 159             push @logs, $1 . ':' . $2;
 160         }
 161     }
 162     return if !@logs;    # we should find one
 163     return \@logs;
 164 }
 165
 166 sub _recheck_logfile {    # recheck saved logfile when logging message
 167     my $self = shift;
 168
 169     return 1 if !exists $self->{logs};    # remember? your own responsibility
 170     my $opac = $self->{cat} =~ /^OPAC/;
 171     my $log;
 172     foreach ( @{ $self->{logs} } ) {
 173         $log = $_ if $opac && /^OPAC:/ || !$opac && /^INTRANET:/;
 174         last if $log;
 175     }
 176     $log =~ s/^(OPAC|INTRANET)://;
 177     return -w $log;
 178 }
 179
 180 =head1 AUTHOR
 181
 182 Kyle M Hall, E<lt>kyle@bywatersolutions.comE<gt>
 183 Marcel de Rooy, Rijksmuseum
 184
 185 =cut
 186
 187 1;
 188
 189 __END__