Bug 26673: Fix perlcritic complains

[koha-ffzg.git] / Koha / Logger.pm

diff --git a/Koha/Logger.pm b/Koha/Logger.pm
index 2fcbb6f..2751bf1 100644 (file)
--- a/Koha/Logger.pm
+++ b/Koha/Logger.pm
@@ -5,26 +5,30 @@ package Koha::Logger;
 #
 # This file is part of Koha.
 #
-# Koha is free software; you can redistribute it and/or modify it under the
-# terms of the GNU General Public License as published by the Free Software
-# Foundation; either version 3 of the License, or (at your option) any later
-# version.
+# Koha is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
 #
-# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
-# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
-# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+# Koha is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
 #
-# You should have received a copy of the GNU General Public License along
-# with Koha; if not, write to the Free Software Foundation, Inc.,
-# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+# You should have received a copy of the GNU General Public License
+# along with Koha; if not, see <http://www.gnu.org/licenses>.
 
 =head1 NAME
 
-Koha::Log
+Koha::Logger
 
 =head1 SYNOPSIS
 
-  use Koha::Log;
+    use Koha::Logger;
+
+    my $logger = Koha::Logger->get;
+    $logger->warn( 'WARNING: Serious error encountered' );
+    $logger->debug( 'I thought that this code was not used' );
 
 =head1 FUNCTIONS
 
@@ -39,34 +43,114 @@ use C4::Context;
 
 BEGIN {
     Log::Log4perl->wrapper_register(__PACKAGE__);
+}
+
+=head2 get
+
+    Returns a logger object (based on log4perl).
+    Category and interface hash parameter are optional.
+    Normally, the category should follow the current package and the interface
+    should be set correctly via C4::Context.
+
+=cut
+
+sub get {
+    my ( $class, $params ) = @_;
+    my $interface = $params ? ( $params->{interface} || C4::Context->interface ) : C4::Context->interface;
+    my $category = $params ? ( $params->{category} || caller ) : caller;
+    my $l4pcat = $interface . '.' . $category;
+
+    my $init = _init();
+    my $self = {};
+    if ($init) {
+        $self->{logger} = Log::Log4perl->get_logger($l4pcat);
+        $self->{cat}    = $l4pcat;
+        $self->{logs}   = $init if ref $init;
+    }
+    bless $self, $class;
+    return $self;
+}
+
+=head1 INTERNALS
+
+=head2 AUTOLOAD
 
-    my $conf;
-    if ( exists $ENV{"LOG4PERL_CONF"} and $ENV{'LOG4PERL_CONF'} and -s $ENV{"LOG4PERL_CONF"} ) {
+    In order to prevent a crash when log4perl cannot write to Koha logfile,
+    we check first before calling log4perl.
+    If log4perl would add such a check, this would no longer be needed.
 
-        # Check for web server level configuration first
-        $conf = $ENV{"LOG4PERL_CONF"};
+=cut
+
+sub AUTOLOAD {
+    my ( $self, $line ) = @_;
+    my $method = $Koha::Logger::AUTOLOAD;
+    $method =~ s/^Koha::Logger:://;
+
+    if ( $self->{logger}->can($method) ) {    #use log4perl
+        return $self->{logger}->$method($line);
     }
-    else {
-        # If no web server level config exists, look in the koha conf file for one
-        $conf = C4::Context->config("log4perl_conf");
+    else {                                       # we should not really get here
+        warn "ERROR: Unsupported method $method";
     }
+    return;
+}
 
-    Log::Log4perl->init_once($conf);
+=head2 DESTROY
+
+    Dummy destroy to prevent call to AUTOLOAD
+
+=cut
+
+sub DESTROY { }
+
+=head2 _init
+
+=cut
+
+sub _init {
+
+    my $log4perl_config =
+          exists $ENV{"LOG4PERL_CONF"}
+              && $ENV{'LOG4PERL_CONF'}
+           && -s $ENV{"LOG4PERL_CONF"}
+      # Check for web server level configuration first
+      # In this case we ASSUME that you correctly arranged logfile
+      # permissions. If not, log4perl will crash on you.
+      ? $ENV{"LOG4PERL_CONF"}
+      : C4::Context->config("log4perl_conf");
+
+    # This will explode with the relevant error message if something is wrong in the config file
+    return Log::Log4perl->init_once($log4perl_config);
 }
 
-sub get {
-    my ( $class, $category, $interface ) = @_;
+=head2 debug_to_screen
+
+Adds a new appender for the given logger that will log all DEBUG-and-higher messages to stderr.
+Useful for daemons.
+
+=cut
+
+sub debug_to_screen {
+    my $self = shift;
 
-    croak("No category passed in!") unless $category;
+    return unless ( $self->{logger} );
 
-    $interface ||= C4::Context->interface();
+    my $appender = Log::Log4perl::Appender->new(
+        'Log::Log4perl::Appender::Screen',
+        stderr => 1,
+        utf8 => 1,
+        name => 'debug_to_screen' # We need a specific name to prevent duplicates
+    );
 
-    return Log::Log4perl->get_logger("$interface.$category");
+    $appender->threshold( $Log::Log4perl::DEBUG );
+    $self->{logger}->add_appender( $appender );
+    $self->{logger}->level( $Log::Log4perl::DEBUG );
 }
 
 =head1 AUTHOR
 
 Kyle M Hall, E<lt>kyle@bywatersolutions.comE<gt>
+Marcel de Rooy, Rijksmuseum
 
 =cut