From f018d7888270fd9ff5ebb1ef155c7a7ae4cc094d Mon Sep 17 00:00:00 2001
From: Jonathan Druart <jonathan.druart@biblibre.com>
Date: Tue, 5 Jun 2012 15:51:06 +0200
Subject: [PATCH] Bug 8190: Koha::Utils::Logger, Logging module

use Koha::Utils::Logger qw/$log/;
$log = Koha::Utils::Logger->new;
$log->debug("This is a debug message");
$log->info("This is an information");
$log->error("This is an error !");

The Logger constructor can take an hash reference with "file" and
"level" to define a filepath or a log level.

For a log level >= warning, a call stack is printed.

Prerequisite:
- set an environment variable KOHA_LOG in your virtual host:
    SetEnv KOHA_LOG /home/koha/var/log/opac.log
- set a write flag for www-data on this file

  Please have a look at t/Logger.t for more details.

Signed-off-by: Mason James <mtj@kohaaloha.com>
Signed-off-by: Kyle M Hall <kyle@bywatersolutions.com>

Bug 8190: Followup Logger: FIX perlcritic

Signed-off-by: Mason James <mtj@kohaaloha.com>
Signed-off-by: Kyle M Hall <kyle@bywatersolutions.com>

Bug 8190 - Followup - Add cached logger, output messages to template

* Add C4::Context->logger
* Embed logged messageds to a comment in the template html,
  controlled by the system preference LogToHtmlComments\
* Add both new system preferences to sysprefs.sql

Signed-off-by: Paul Poulain <paul.poulain@biblibre.com>
---
 C4/Auth.pm                                         |    3 +
 C4/Context.pm                                      |   28 +++
 C4/Installer/PerlDependencies.pm                   |    5 +
 Koha/Utils/Logger.pm                               |  186 ++++++++++++++++++++
 install_misc/debian.packages                       |    1 +
 installer/data/mysql/sysprefs.sql                  |    2 +
 installer/data/mysql/updatedatabase.pl             |   11 ++
 .../prog/en/includes/doc-head-open.inc             |    5 +
 .../prog/en/modules/admin/preferences/admin.pref   |   20 +++
 opac/opac-search.pl                                |    4 +
 t/Logger.t                                         |   95 ++++++++++
 11 files changed, 360 insertions(+)
 create mode 100644 Koha/Utils/Logger.pm
 create mode 100644 t/Logger.t

diff --git a/C4/Auth.pm b/C4/Auth.pm
index 705eda0..7a3c44b 100644
--- a/C4/Auth.pm
+++ b/C4/Auth.pm
@@ -364,6 +364,8 @@ sub get_template_and_user {
             OPACLocalCoverImages        => C4::Context->preference('OPACLocalCoverImages'),
             AllowMultipleCovers         => C4::Context->preference('AllowMultipleCovers'),
             EnableBorrowerFiles         => C4::Context->preference('EnableBorrowerFiles'),
+            LogToHtmlComments           => C4::Context->preference('LogToHtmlComments'),
+            Logger                      => C4::Context->logger(),
         );
     }
     else {
@@ -466,6 +468,7 @@ sub get_template_and_user {
 
         $template->param(OpacPublic => '1') if ($user || C4::Context->preference("OpacPublic"));
     }
+
     return ( $template, $borrowernumber, $cookie, $flags);
 }
 
diff --git a/C4/Context.pm b/C4/Context.pm
index bd1f235..04b9b71 100644
--- a/C4/Context.pm
+++ b/C4/Context.pm
@@ -20,6 +20,8 @@ use strict;
 use warnings;
 use vars qw($VERSION $AUTOLOAD $context @context_stack $servers $memcached $ismemcached);
 
+use Koha::Utils::Logger;
+
 BEGIN {
 	if ($ENV{'HTTP_USER_AGENT'})	{
 		require CGI::Carp;
@@ -1177,6 +1179,32 @@ sub tz {
     return $context->{tz};
 }
 
+=head2 logger
+
+  $logger = C4::Context->logger;
+
+Returns a Koha logger. If no logger has yet been instantiated,
+this method creates one, and caches it.
+
+=cut
+
+sub logger
+{
+    my $self = shift;
+    my $sth;
+
+    if ( defined( $context->{"logger"} ) ) {
+	return $context->{"logger"};
+    }
+
+    $context->{"logger"} = Koha::Utils::Logger->new(
+        {
+            level => C4::Context->preference("LogLevel")
+        }
+    );
+
+    return $context->{"logger"};
+}
 
 
 1;
diff --git a/C4/Installer/PerlDependencies.pm b/C4/Installer/PerlDependencies.pm
index 71f35d4..fd47717 100644
--- a/C4/Installer/PerlDependencies.pm
+++ b/C4/Installer/PerlDependencies.pm
@@ -629,6 +629,11 @@ our $PERL_DEPS = {
         'required' => '0',
         'min_ver'  => '1.09',
       },
+    'Log::LogLite' => {
+        usage    => 'Core',
+        required => '1',
+        min_ver  => '0.82',
+    },
 };
 
 1;
diff --git a/Koha/Utils/Logger.pm b/Koha/Utils/Logger.pm
new file mode 100644
index 0000000..e3937fc
--- /dev/null
+++ b/Koha/Utils/Logger.pm
@@ -0,0 +1,186 @@
+package Koha::Utils::Logger;
+
+# Copyright 2012 Biblibre SARL
+#
+# 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 2 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.
+#
+# 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.
+
+use Modern::Perl;
+use Log::LogLite;
+
+use base 'Exporter';
+our @EXPORT_OK = qw($log);
+
+my $UNUSABLE_LOG_LEVEL = 1;
+my $CRITICAL_LOG_LEVEL = 2;
+my $ERROR_LOG_LEVEL    = 3;
+my $WARNING_LOG_LEVEL  = 4;
+my $NORMAL_LOG_LEVEL   = 5;
+my $INFO_LOG_LEVEL     = 6;
+my $DEBUG_LOG_LEVEL    = 7;
+
+my $LEVEL_STR = {
+    $UNUSABLE_LOG_LEVEL => 'UNUS  ',
+    $CRITICAL_LOG_LEVEL => 'CRIT  ',
+    $ERROR_LOG_LEVEL    => 'ERROR ',
+    $WARNING_LOG_LEVEL  => 'WARN  ',
+    $NORMAL_LOG_LEVEL   => 'NORMAL',
+    $INFO_LOG_LEVEL     => 'INFO  ',
+    $DEBUG_LOG_LEVEL    => 'DEBUG ',
+};
+
+use Data::Dumper;
+
+our $log = undef;
+
+sub new {
+    my ( $proto, $params ) = @_;
+
+    return $log
+      if $log
+          and (  not defined $params->{file}
+              or not defined $log->{FILE_PATH}
+              or $params->{file} eq $log->{FILE_PATH} );
+    my $class    = ref($proto) || $proto;
+    my $self     = {};
+    my $LOG_PATH = defined $ENV{KOHA_LOG} ? $ENV{KOHA_LOG} : undef;
+    $self->{FILE_PATH} = defined $params->{file}  ? $params->{file}  : $LOG_PATH;
+    $self->{LEVEL}     = defined $params->{level} ? $params->{level} : $INFO_LOG_LEVEL;
+    $self->{LOGGED_MESSAGES} = [];
+
+    if ( not defined $self->{FILE_PATH} ) {
+        return bless( $self, $class );
+    }
+    eval { $self->{LOGGER} = Log::LogLite->new( $self->{FILE_PATH}, $self->{LEVEL} ); };
+    die "Log system is not correctly configured ($@)" if $@;
+    return bless( $self, $class );
+}
+
+sub write {
+    my ( $self, $msg, $log_level, $dump, $cb ) = @_;
+
+    if ( not $self->{LOGGER} ) {
+        if ( $log_level <= $self->{LEVEL} ) {
+            print STDERR "[" . localtime() . "] " . "$LEVEL_STR->{$log_level}: " . $msg . ( $cb ? " (" . $cb . ")" : "" ) . "\n";
+        }
+        return;
+    }
+    my $template = "[<date>] $LEVEL_STR->{$log_level}: <message>";
+    $template .= " (caller: $cb)" if $cb;
+    $template .= "\n";
+    $self->{LOGGER}->template($template);
+    $msg = "\n" . Dumper $msg if $dump;
+    $self->{LOGGER}->write( $msg, $log_level );
+
+    if ( $log_level <= $self->{LEVEL} ) {
+        my $message = "[" . localtime() . "] " . "$LEVEL_STR->{$log_level}: " . $msg . ( $cb ? " (" . $cb . ")" : "" ) . "\n";
+        push( @{ $self->{LOGGED_MESSAGES} }, $message );
+    }
+}
+
+sub unusable {
+    my ( $self, $msg, $dump ) = @_;
+    my $cb = $self->called_by();
+    $self->write( $msg, $UNUSABLE_LOG_LEVEL, $dump, $cb );
+}
+
+sub critical {
+    my ( $self, $msg, $dump ) = @_;
+    my $cb = $self->called_by();
+    $self->write( $msg, $CRITICAL_LOG_LEVEL, $dump, $cb );
+}
+
+sub error {
+    my ( $self, $msg, $dump ) = @_;
+    my $cb = $self->called_by();
+    $self->write( $msg, $ERROR_LOG_LEVEL, $dump, $cb );
+}
+
+sub warning {
+    my ( $self, $msg, $dump ) = @_;
+    my $cb = $self->called_by();
+    $self->write( $msg, $WARNING_LOG_LEVEL, $dump, $cb );
+}
+
+sub log {
+    my ( $self, $msg, $dump ) = @_;
+    $self->write( $msg, $NORMAL_LOG_LEVEL, $dump );
+}
+
+sub normal {
+    my ( $self, $msg, $dump ) = @_;
+    $self->write( $msg, $NORMAL_LOG_LEVEL, $dump );
+}
+
+sub info {
+    my ( $self, $msg, $dump ) = @_;
+    $self->write( $msg, $INFO_LOG_LEVEL, $dump );
+}
+
+sub debug {
+    my ( $self, $msg, $dump ) = @_;
+    $self->write( $msg, $DEBUG_LOG_LEVEL, $dump );
+}
+
+sub level {
+    my $self = shift;
+
+    return $self->{LOGGER}
+      ? $self->{LOGGER}->level(@_)
+      : ( $self->{LEVEL} = @_ ? shift : $self->{LEVEL} );
+}
+
+sub called_by {
+    my $self  = shift;
+    my $depth = 2;
+    my $args;
+    my $pack;
+    my $file;
+    my $line;
+    my $subr;
+    my $has_args;
+    my $wantarray;
+    my $evaltext;
+    my $is_require;
+    my $hints;
+    my $bitmask;
+    my @subr;
+    my $str = "";
+
+    while (1) {
+        ( $pack, $file, $line, $subr, $has_args, $wantarray, $evaltext, $is_require, $hints, $bitmask ) = caller($depth);
+        unless ( defined($subr) ) {
+            last;
+        }
+        $depth++;
+        $line = (3) ? "$file:" . $line . "-->" : "";
+        push( @subr, $line . $subr );
+    }
+    @subr = reverse(@subr);
+    foreach my $sr (@subr) {
+        $str .= $sr;
+        $str .= " > ";
+    }
+    $str =~ s/ > $/: /;
+    return $str;
+}    # of called_by
+
+sub get_messages {
+    my $self = shift;
+
+    return $self->{LOGGED_MESSAGES};
+}
+
+1;
diff --git a/install_misc/debian.packages b/install_misc/debian.packages
index 2460555..2946e16 100644
--- a/install_misc/debian.packages
+++ b/install_misc/debian.packages
@@ -64,6 +64,7 @@ liblist-moreutils-perl	install
 liblocale-currency-format-perl install
 liblocale-gettext-perl	install
 liblocale-po-perl	install
+liblog-loglite-perl install
 libmail-sendmail-perl install
 libmarc-charset-perl install
 libmarc-crosswalk-dublincore-perl install
diff --git a/installer/data/mysql/sysprefs.sql b/installer/data/mysql/sysprefs.sql
index 44f9eb3..dc156df 100644
--- a/installer/data/mysql/sysprefs.sql
+++ b/installer/data/mysql/sysprefs.sql
@@ -387,3 +387,5 @@ INSERT INTO systempreferences (variable,value,explanation,type) VALUES('INTRAdid
 INSERT INTO systempreferences (variable, value, options, explanation, type) VALUES ('BlockReturnOfWithdrawnItems', '1', '0', 'If enabled, items that are marked as withdrawn cannot be returned.', 'YesNo');
 INSERT INTO systempreferences (variable,value,explanation,options,type) VALUES('HoldsToPullStartDate','2','Set the default start date for the Holds to pull list to this many days ago',NULL,'Integer');
 INSERT INTO systempreferences (variable,value,explanation,options,type) VALUES('alphabet','A B C D E F G H I J K L M N O P Q R S T U V W X Y Z','Alphabet than can be expanded into browse links, e.g. on Home > Patrons',NULL,'free');
+INSERT INTO systempreferences (variable,value,explanation,options,type) VALUES ('LogLevel','5','Set the level of logs. 1=Unusable, 2=Critical, 3=Error, 4=Warning, 5=Normal, 6=Info, 7=Debug','1|2|3|4|5|6|7','Choice');
+INSERT INTO systempreferences (variable,value,explanation,options,type) VALUES ('LogToHtmlComments','0','Embed the logs into the html as a comment.','','YesNo');
diff --git a/installer/data/mysql/updatedatabase.pl b/installer/data/mysql/updatedatabase.pl
index 966ec9b..7fdfd33 100755
--- a/installer/data/mysql/updatedatabase.pl
+++ b/installer/data/mysql/updatedatabase.pl
@@ -5785,6 +5785,17 @@ $DBversion = "3.09.00.045";
 if ( C4::Context->preference("Version") < TransformToNum($DBversion) ) {
     $dbh->do("ALTER TABLE borrower_attribute_types MODIFY category_code VARCHAR( 10 ) NULL DEFAULT NULL");
     print "Upgrade to $DBversion done. (Bug 8002: Update patron attribute types table from varchar(1) to varchar(10) category_code)\nWarning to Koha System Administrators: If you use borrower attributes defined by borrower categories, you have to check your configuration. A bug may have removed your attribute links to borrower categories.\nPlease check, and fix it if necessary.";
+}
+
+$DBversion = "3.09.00.XXX";
+if ( C4::Context->preference("Version") < TransformToNum($DBversion) ) {
+    $dbh->do(qq{
+        INSERT IGNORE INTO systempreferences (variable,value,explanation,options,type) VALUES ('LogLevel','5','Set the level of logs. 1=Unusable, 2=Critical, 3=Error, 4=Warning, 5=Normal, 6=Info, 7=Debug','1|2|3|4|5|6|7','Choice');
+    });
+    $dbh->do(qq{
+        INSERT IGNORE INTO systempreferences (variable,value,explanation,options,type) VALUES ('LogToHtmlComments','0','Embed the logs into the html as a comment.','','YesNo');
+    });
+    print "Upgrade to $DBversion done (Add system preferences LogLevel, LogToHtmlComments)\n";
     SetVersion($DBversion);
 }
 
diff --git a/koha-tmpl/intranet-tmpl/prog/en/includes/doc-head-open.inc b/koha-tmpl/intranet-tmpl/prog/en/includes/doc-head-open.inc
index b8aa2ad..431f566 100644
--- a/koha-tmpl/intranet-tmpl/prog/en/includes/doc-head-open.inc
+++ b/koha-tmpl/intranet-tmpl/prog/en/includes/doc-head-open.inc
@@ -2,3 +2,8 @@
     "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
 [% IF ( bidi ) %]<html lang="[% lang %]" xml:lang="[% lang %]" dir="[% bidi %]" xmlns="http://www.w3.org/1999/xhtml">[% ELSE %]<html lang="[% lang %]" xml:lang="[% lang %]" xmlns="http://www.w3.org/1999/xhtml">[% END %]
 <head>
+[%- IF LogToHtmlComments %]
+<!-- LOG MESSAGES
+[% FOREACH message IN Logger.get_messages() %][% message %][% END %]
+-->
+[% END %]
diff --git a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/admin.pref b/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/admin.pref
index 4e907e1..3d677f1 100644
--- a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/admin.pref
+++ b/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/admin.pref
@@ -112,3 +112,23 @@ Administration:
                 Solr: Solr
                 Zebra: Zebra
             - is the search engine used.
+    Logger:
+        -
+            - Set the level
+            - pref: LogLevel
+              choices:
+                1: 1- Unusable
+                2: 2- Critical
+                3: 3- Error
+                4: 4- Warning
+                5: 5- Normal
+                6: 6- Info
+                7: 7- Debug
+            - for logs
+        -
+            - pref: LogToHtmlComments
+              default: 0
+              choices:
+                  yes: Embed
+                  no: "Don't embed"
+            - log as a comment in the html.
diff --git a/opac/opac-search.pl b/opac/opac-search.pl
index 73d2c53..daee8fb 100755
--- a/opac/opac-search.pl
+++ b/opac/opac-search.pl
@@ -51,12 +51,15 @@ use C4::Tags qw(get_tags);
 use C4::Branch; # GetBranches
 use C4::SocialData;
 use C4::Ratings;
+use Koha::Utils::Logger qw/$log/;
 
 use POSIX qw(ceil floor strftime);
 use URI::Escape;
 use Storable qw(thaw freeze);
 use Business::ISBN;
 
+$log = Koha::Utils::Logger->new({level => C4::Context->preference("LogLevel")});
+
 my $DisplayMultiPlaceHold = C4::Context->preference("DisplayMultiPlaceHold");
 # create a new CGI object
 # FIXME: no_undef_params needs to be tested
@@ -492,6 +495,7 @@ elsif (C4::Context->preference('NoZebra')) {
     $pasarParams .= '&amp;count=' . $results_per_page;
     $pasarParams .= '&amp;simple_query=' . $simple_query;
     $pasarParams .= '&amp;query_type=' . $query_type if ($query_type);
+    $log->info("OPAC: Search for $query");
     eval {
         ($error, $results_hashref, $facets) = getRecords($query,$simple_query,\@sort_by,\@servers,$results_per_page,$offset,$expanded_facet,$branches,$itemtypes,$query_type,$scan,1);
     };
diff --git a/t/Logger.t b/t/Logger.t
new file mode 100644
index 0000000..bff7733
--- /dev/null
+++ b/t/Logger.t
@@ -0,0 +1,95 @@
+#!/usr/bin/perl
+
+use utf8;
+use Modern::Perl;
+if ( not $ENV{KOHA_LOG} ) {
+    usage();
+    exit;
+}
+
+use Test::More;
+require C4::Context;
+import C4::Context;
+plan tests => 15;
+
+my $logfile = $ENV{KOHA_LOG};
+
+use_ok('Koha::Utils::Logger');
+isnt(C4::Context->preference("LogLevel"), undef, "Check LogLevel syspref");
+use Koha::Utils::Logger qw/$log/;
+is($log, undef, "Check \$log is undef");
+$log = Koha::Utils::Logger->new({level => 3});
+isnt($log, undef, "Check \$log is not undef");
+
+
+my @lines = ();
+$log->error( "an error string");
+$log->normal( "a normal string");
+@lines = get_contains( $logfile );
+is(grep (/an error string/, @lines), 1, "check error string with level 3");
+is(grep (/a normal string/, @lines), 0, "check normal string with level 3");
+truncate_file($logfile);
+$log->level(5);
+$log->error( "an error string");
+$log->normal( "a normal string");
+test_calledby( "test calledby" );
+my $struct = {
+    a => "aaaaa",
+    b => "bbbbb",
+    c => "ccccc"
+};
+$log->warning($struct, 1);
+@lines = get_contains( $logfile );
+is(grep (/an error string/, @lines), 1, "check error string with level 5");
+is(grep (/a normal string/, @lines), 1, "check normal string with level 5");
+is(grep (/test_calledby/, @lines), 1, "check calledby string with level 5");
+is(grep (/WARN/, @lines), 1, "check WARN string with dump");
+is(grep (/VAR1/, @lines), 1, "check VAR1 string with dump");
+is(grep (/aaaaa/, @lines), 1, "check values aaaaa string with dump");
+is(5, $log->level, "check log level return");
+
+
+$ENV{KOHA_LOG} = undef;
+my $log_stderr_file = qq{/tmp/stderr.log};
+$log = undef;
+$log = Koha::Utils::Logger->new({level => 3});
+open(STDERR, '>>', $log_stderr_file);
+$log->error( "an error string");
+$log->normal( "a normal string");
+@lines = get_contains( $log_stderr_file );
+is(grep (/an error string/, @lines), 1, "check error string with level 3");
+is(grep (/a normal string/, @lines), 0, "check normal string with level 3");
+
+system( qq{rm $logfile} );
+system( qq{rm $log_stderr_file} );
+
+sub get_contains {
+    my $filepath = shift;
+    my @lines;
+    open my $fh, "<", $filepath or die "Can't open $filepath: $!";
+    while(<$fh>) {
+        chomp;
+        push(@lines, $_);
+    }
+    close($fh);
+    return @lines;
+}
+
+sub truncate_file {
+    my $filepath = shift;
+    open my $fh, ">", $filepath or die "Can't open $filepath: $!";
+    truncate $fh, 0;
+    close $fh;
+}
+
+sub test_calledby {
+    my $msg = shift;
+    $log->error($msg);
+}
+
+sub usage {
+    warn "\n\n+=======================================================+\n";
+    warn   qq{| You must call this test with a KOHA_LOG env var like: |\n};
+    warn   qq{| KOHA_LOG="/tmp/t1.log" prove t/Logguer.t              |\n};
+    warn     "+=======================================================+\n\n";
+}
-- 
1.7.9.5