[Koha-patches] [PATCH] Implement Log4perl to improve our logging and debugging information
Andrew Moore
andrew.moore at liblime.com
Fri Sep 5 22:10:35 CEST 2008
This patch implements Log4perl as discussed on koha-devel here
<http://markmail.org/message/3rzb6spq6at3scjd>. I think this is ready
to apply, but I'm open to suggestions.
Here's a quick usage summary:
in .pm files:
our $logger = Log::Log4perl->get_logger( __PACKAGE__ );
$logger->debug( 'this is a debug message' );
$logger->info( 'this is an info message' );
in .pl CGI files:
my $logger = C4::Debug::logger();
$logger->debug( 'this is a debug message' );
If this patch or something like it gets accepted, I'll update the wiki
to describe how to make use of some of the features of Log4perl to
make it easier to troubleshoot or log parts of Koha.
There are several parts to this patch:
Log::Log4perl 1.07 is now a requirement in Makefile.PL. This version
was chosen because it's the latest one for which there exists debian
etch packages. 1.18 is currently the newest version available from
the CPAN.
Log4perl initialization is done in C4::Context, and a more simple
version exists in C4::Debug for any code that uses C4::Debug only and
not C4::Context. (Yes, I think there is some). It's not done in a
begin block anymore.
Log4perl configuration exists in the log4perl.conf file. It resides in
the same conf directory as your koha.conf file. It is set by default
to log to the same var/log directory as the rest of the logs. By
default, all of the Koha application logs go to one "koha.log" file,
and only those of "WARN" or more severe level are logged. This means
that there's a new entry in your koha-conf.xml file that points to the
log4perl configuration file.
There is still a __WARN__ handler in C4::Debug that catches calls to
'warn' and sends that output to the koha.log file. I view this as a
temporary measure to be used until we stop directly calling 'warn'.
All of the calls to 'warn' in C4::Members have been replaced by calls
to Log4perl. This is an example of how we can use it in the other
modules, too. I've tried to give each of the calls reasonable levels,
but that might be something that evolves.
There is still a call to log4perl in opac/opac-search.pl. It's an
example of how it can be used directly in the CGI scripts. In this
case, it's logging OPAC searches, a recently requested feature.
There have been changes to the Makefile.PL and the t/Makefile to get
the log4perl.conf rewritten correctly and moved to the right place.
---
C4/Context.pm | 6 +++-
C4/Debug.pm | 68 ++++++++++++++++++++++++++++++++++++++++++++++++---
C4/Members.pm | 41 ++++++++++++++++++++----------
Makefile.PL | 2 +
etc/koha-conf.xml | 1 +
etc/log4perl.conf | 15 +++++++++++
opac/opac-search.pl | 1 +
t/Makefile | 16 ++++++------
8 files changed, 123 insertions(+), 27 deletions(-)
create mode 100644 etc/log4perl.conf
diff --git a/C4/Context.pm b/C4/Context.pm
index 7813f49..c473306 100644
--- a/C4/Context.pm
+++ b/C4/Context.pm
@@ -83,6 +83,7 @@ BEGIN {
use DBI;
use ZOOM;
use XML::Simple;
+use Log::Log4perl qw(:easy);
use C4::Boolean;
use C4::Debug;
@@ -268,7 +269,10 @@ sub import {
# if successfully loaded, use it by default
$new_ctx->set_context;
- 1;
+
+ Log::Log4perl->init( $new_ctx->config('log4perl_conf_file') );
+
+ return 1;
}
=item new
diff --git a/C4/Debug.pm b/C4/Debug.pm
index 357764a..2d3ca0a 100644
--- a/C4/Debug.pm
+++ b/C4/Debug.pm
@@ -21,6 +21,7 @@ use strict;
use warnings;
use Exporter;
+use Log::Log4perl qw(:easy);
# use CGI;
use vars qw($VERSION @ISA @EXPORT $debug $cgi_debug);
@@ -65,10 +66,69 @@ BEGIN {
}
}
-# sub import {
-# print STDERR __PACKAGE__ . " (Debug) import @_\n";
-# C4::Debug->export_to_level(1, @_);
-# }
+# Since Log4perl is initialized in C4::Context, it is only initialized
+# here for code that does not use C4::Context.
+
+if(! Log::Log4perl->initialized()) {
+ use Log::Log4perl qw(:easy);
+ Log::Log4perl->easy_init($DEBUG);
+}
+
+=head2 __WARN__ handler
+
+=over 4
+
+this overrides calls to C<warn> so that they don't get written to
+STDOUT (which goes to the apache log), but instead get run through
+Log4perl. This should be removed after all calls to C<warn> in the
+Koha code are replaced by calls to Log4perl. That way, complaints from
+perl go to the apache log, and complaints from the Koha application
+are handled by Log4perl.
+
+All warn statements go through Log4perl at the "warn" level.
+
+C<warn> statements from packages defined in .pm files are given
+Log4perl categories that match their package. C<warn> statments from
+.pl scripts are logged under the category "main".
+
+=back
+
+=cut
+
+$SIG{__WARN__} = sub {
+ local $Log::Log4perl::caller_depth = $Log::Log4perl::caller_depth + 1;
+ my $package = caller; # pass in the package name of our caller
+ my $logger = logger($package);
+ my @warningmessage = @_;
+ chomp($warningmessage[$#warningmessage]); # remove \n from last element. 'warn' puts it on there.
+ $logger->warn( @warningmessage );
+};
+
+=head2 logger
+
+=over 4
+
+this function returns a Log4perl object. It's not strictly necessary
+since you can call many of the Log4perl methods as class methods just
+fine. But, it's a convenience method to help set the logging category.
+
+ my $logger = C4::Debug::logger();
+ $logger->debug( 'this is a debug message' );
+
+ my $logger = C4::Debug::logger( 'opac' );
+ $logger->debug( 'this is a debug message' );
+
+parameters:
+ log_category: defaults to the package namespace of the caller.
+
+=back
+
+=cut
+
+sub logger {
+ my $log_category = shift || caller; # default to the package namespace of our caller.
+ my $logger = Log::Log4perl->get_logger($log_category);
+}
1;
__END__
diff --git a/C4/Members.pm b/C4/Members.pm
index 7df9424..457dd0f 100644
--- a/C4/Members.pm
+++ b/C4/Members.pm
@@ -31,6 +31,12 @@ use C4::Biblio;
our ($VERSION, at ISA, at EXPORT, at EXPORT_OK,$debug);
+# initialize a log4perl object to be used throughout this module. We
+# give it a category of C4::Members. This lets us call methods on it
+# with the logging separated out into different places from the rest
+# of the application, if we want.
+our $logger = Log::Log4perl->get_logger( __PACKAGE__ );
+
BEGIN {
$VERSION = 3.02;
$debug = $ENV{DEBUG} || 0;
@@ -568,7 +574,7 @@ sub GetMemberIssuesAndFines {
my $dbh = C4::Context->dbh;
my $query = "SELECT COUNT(*) FROM issues WHERE borrowernumber = ?";
- $debug and warn $query."\n";
+ $logger->debug( $query );
my $sth = $dbh->prepare($query);
$sth->execute($borrowernumber);
my $issue_count = $sth->fetchrow_arrayref->[0];
@@ -619,10 +625,10 @@ sub ModMember {
foreach (qw(dateofbirth dateexpiry dateenrolled)) {
if (my $tempdate = $data{$_}) { # assignment, not comparison
($tempdate =~ /$iso_re/) and next; # Congatulations, you sent a valid ISO date.
- warn "ModMember given $_ not in ISO format ($tempdate)";
+ $logger->warn( "ModMember given $_ not in ISO format ($tempdate)" );
my $tempdate2 = format_date_in_iso($tempdate);
if (!$tempdate2 or $tempdate2 eq '0000-00-00') {
- warn "ModMember cannot convert '$tempdate' (from syspref to ISO)";
+ $logger->warn( "ModMember cannot convert '$tempdate' (from syspref to ISO)" );
next;
}
$data{$_} = $tempdate2;
@@ -656,7 +662,7 @@ sub ModMember {
delete $data{$_};
}
}
- (@badkeys) and warn scalar(@badkeys) . " Illegal key(s) passed to ModMember: " . join(',', at badkeys);
+ (@badkeys) and $logger->error( scalar(@badkeys) . " Illegal key(s) passed to ModMember: " . join(',', at badkeys) );
$query =~ s/, $//;
$query .= " WHERE borrowernumber=?";
push @parameters, $data{'borrowernumber'};
@@ -1789,14 +1795,14 @@ Returns the mimetype and binary image data of the image for the patron with the
sub GetPatronImage {
my ($cardnumber) = @_;
- warn "Cardnumber passed to GetPatronImage is $cardnumber" if $debug;
+ $logger->debug( "Cardnumber passed to GetPatronImage is $cardnumber" );
my $dbh = C4::Context->dbh;
my $query = 'SELECT mimetype, imagefile FROM patronimage WHERE cardnumber = ?';
my $sth = $dbh->prepare($query);
$sth->execute($cardnumber);
my $imagedata = $sth->fetchrow_hashref;
my $dberror = $sth->errstr;
- warn "Database error!" if $sth->errstr;
+ $logger->error( "Database error!" ) if $sth->errstr;
$sth->finish;
return $imagedata, $dberror;
}
@@ -1812,12 +1818,12 @@ NOTE: This function is good for updating images as well as inserting new images
sub PutPatronImage {
my ($cardnumber, $mimetype, $imgfile) = @_;
- warn "Parameters passed in: Cardnumber=$cardnumber, Mimetype=$mimetype, " . ($imgfile ? "Imagefile" : "No Imagefile") if $debug;
+ $logger->debug( "Parameters passed in: Cardnumber=$cardnumber, Mimetype=$mimetype, " . ($imgfile ? "Imagefile" : "No Imagefile") );
my $dbh = C4::Context->dbh;
my $query = "INSERT INTO patronimage (cardnumber, mimetype, imagefile) VALUES (?,?,?) ON DUPLICATE KEY UPDATE imagefile = ?;";
my $sth = $dbh->prepare($query);
$sth->execute($cardnumber,$mimetype,$imgfile,$imgfile);
- warn "Error returned inserting $cardnumber.$mimetype." if $sth->errstr;
+ $logger->error( "Error returned inserting $cardnumber.$mimetype." ) if $sth->errstr;
my $dberror = $sth->errstr;
$sth->finish;
return $dberror;
@@ -1833,13 +1839,13 @@ Removes the image for the patron with the supplied cardnumber.
sub RmPatronImage {
my ($cardnumber) = @_;
- warn "Cardnumber passed to GetPatronImage is $cardnumber" if $debug;
+ $logger->debug( "Cardnumber passed to GetPatronImage is $cardnumber" );
my $dbh = C4::Context->dbh;
my $query = "DELETE FROM patronimage WHERE cardnumber = ?;";
my $sth = $dbh->prepare($query);
$sth->execute($cardnumber);
my $dberror = $sth->errstr;
- warn "Database error!" if $sth->errstr;
+ $logger->error( "Database error!" ) if $sth->errstr;
$sth->finish;
return $dberror;
}
@@ -1872,7 +1878,7 @@ WHERE roadtypeid=?|;
&GetBorrowersWhoHaveNotBorrowedSince($date)
this function get all borrowers who haven't borrowed since the date given on input arg.
-
+
=cut
sub GetBorrowersWhoHaveNotBorrowedSince {
@@ -1904,7 +1910,7 @@ sub GetBorrowersWhoHaveNotBorrowedSince {
$query.=" HAVING latestissue <? OR latestissue IS NULL";
push @query_params,$filterdate;
}
- warn $query if $debug;
+ $logger->debug( $query );
my $sth = $dbh->prepare($query);
if (scalar(@query_params)>0){
$sth->execute(@query_params);
@@ -1950,7 +1956,7 @@ sub GetBorrowersWhoHaveNeverBorrowed {
$query.=" AND borrowers.branchcode= ?";
push @query_params,$filterbranch;
}
- warn $query if $debug;
+ $logger->debug( $query );
my $sth = $dbh->prepare($query);
if (scalar(@query_params)>0){
@@ -2001,7 +2007,7 @@ sub GetBorrowersWithIssuesHistoryOlderThan {
push @query_params, $filterbranch;
}
$query.=" GROUP BY borrowernumber ";
- warn $query if $debug;
+ $logger->debug( $query );
my $sth = $dbh->prepare($query);
$sth->execute(@query_params);
my @results;
@@ -2060,6 +2066,13 @@ sub DebarMember {
return unless defined $borrowernumber;
return unless $borrowernumber =~ /^\d+$/;
+ # Here's an example of using the logger object. You can call
+ # 'debug' 'info', 'warn', 'error', or 'fatal' on it to send
+ # messages with different levels of priority. They may get treated
+ # differently (or ignored entirely) depending on your
+ # configuration.
+ $logger->info( "debarring borrower $borrowernumber" );
+
return ModMember( borrowernumber => $borrowernumber,
debarred => 1 );
diff --git a/Makefile.PL b/Makefile.PL
index 02fd055..495cedd 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -473,6 +473,7 @@ my $pl_files = {
'rewrite-config.PL' => [
'blib/KOHA_CONF_DIR/koha-conf.xml',
'blib/KOHA_CONF_DIR/koha-httpd.conf',
+ 'blib/KOHA_CONF_DIR/log4perl.conf',
'blib/MISC_DIR/koha-install-log'
],
'fix-perl-path.PL' => [ # this script ensures the correct shebang line for the platform installed on...
@@ -564,6 +565,7 @@ WriteMakefile(
'List::Util' => 1.18,
'List::MoreUtils' => 0.21,
'Locale::Language' => 2.07,
+ 'Log::Log4perl' => 1.07,
'MARC::Charset' => 0.98,
'MARC::Crosswalk::DublinCore' => 0.02,
'MARC::File::XML' => 0.88,
diff --git a/etc/koha-conf.xml b/etc/koha-conf.xml
index 3c4da9c..bc197b9 100644
--- a/etc/koha-conf.xml
+++ b/etc/koha-conf.xml
@@ -190,5 +190,6 @@ __PAZPAR2_TOGGLE_XML_POST__
<logdir>__LOG_DIR__</logdir>
<pazpar2url>http://__PAZPAR2_HOST__:__PAZPAR2_PORT__/search.pz2</pazpar2url>
<install_log>__MISC_DIR__/koha-install-log</install_log>
+ <log4perl_conf_file>__KOHA_CONF_DIR__/log4perl.conf</log4perl_conf_file>
</config>
</yazgfs>
diff --git a/etc/log4perl.conf b/etc/log4perl.conf
new file mode 100644
index 0000000..d155c14
--- /dev/null
+++ b/etc/log4perl.conf
@@ -0,0 +1,15 @@
+log_file_root = __LOG_DIR__
+
+# by default all log information can go to a default file, but only at WARN level (or more severe)
+# log4perl.logger = DEBUG, FileAppenderDefault
+# log4perl.logger = INFO, FileAppenderDefault
+log4perl.logger = WARN, FileAppenderDefault
+# log4perl.logger = ERROR, FileAppenderDefault
+# log4perl.logger = FATAL, FileAppenderDefault
+
+log4perl.appender.FileAppenderDefault = Log::Log4perl::Appender::File
+log4perl.appender.FileAppenderDefault.filename = ${log_file_root}/koha.log
+# log4perl.appender.FileAppenderDefault.layout = Log::Log4perl::Layout::SimpleLayout
+
+log4perl.appender.FileAppenderDefault.layout = Log::Log4perl::Layout::PatternLayout
+log4perl.appender.FileAppenderDefault.layout.ConversionPattern = [%d] [%p] [%F:%L]: %m%n
diff --git a/opac/opac-search.pl b/opac/opac-search.pl
index 5f50861..0ddfe1a 100755
--- a/opac/opac-search.pl
+++ b/opac/opac-search.pl
@@ -45,6 +45,7 @@ elsif ($build_grouped_results) {
}
elsif ((@params>=1) || ($cgi->param("q")) || ($cgi->param('multibranchlimit')) || ($cgi->param('limit-yr')) ) {
$template_name = 'opac-results.tmpl';
+ C4::Debug::logger()->debug( 'searched for: ' . $cgi->param('q') );
}
else {
$template_name = 'opac-advsearch.tmpl';
diff --git a/t/Makefile b/t/Makefile
index a049677..e3e315c 100644
--- a/t/Makefile
+++ b/t/Makefile
@@ -19,7 +19,7 @@ PROVE = /usr/bin/prove
PROVE_FLAGS = -v
PERL5LIB = ..
KOHA_CONF_DIR = ../etc
-CONF_FILE_TEMPLATE = $(KOHA_CONF_DIR)/koha-conf.xml
+KOHA_CONF_FILES = koha-conf.xml log4perl.conf
TEST_CONF_FILE = run/etc/koha-conf.xml
MKPATH = $(PERL) "-MExtUtils::Command" -e mkpath
@@ -46,10 +46,10 @@ all ::
$(NOECHO) $(ECHO) Please read it first and edit the variables at the top.
$(NOECHO) $(ECHO) Then, you can run \'make test\'
-config_file :: $(CONF_FILE_TEMPLATE) test_run_dirs
- $(CP) $(CONF_FILE_TEMPLATE) $(TEST_CONF_FILE)
- $(PERL) $(TEST_REWRITE_SCRIPT) --file $(TEST_CONF_FILE)
- $(PERL) $(REAL_REWRITE_SCRIPT) $(TEST_CONF_FILE)
+$(KOHA_CONF_FILES) :: test_run_dirs
+ $(CP) $(KOHA_CONF_DIR)/$@ run/etc/$@
+ $(PERL) $(TEST_REWRITE_SCRIPT) --file run/etc/$@
+ $(PERL) $(REAL_REWRITE_SCRIPT) run/etc/$@
zebra_conf_files :: test_run_dirs $(ZEBRA_CONF_FILES)
@@ -64,11 +64,11 @@ $(SCRIPTS) ::
$(PERL) $(REAL_REWRITE_SCRIPT) $(TEST_SCRIPT_DIR)/$@
$(CHMOD) 755 $(TEST_SCRIPT_DIR)/$@
-test :: config_file $(ZEBRA_CONF_FILES) $(SCRIPTS)
+test :: $(KOHA_CONF_FILES) $(ZEBRA_CONF_FILES) $(SCRIPTS)
KOHA_CONF=$(TEST_CONF_FILE) PERL5LIB=$(PERL5LIB) TEST_CLASS=$(TEST_CLASS) RUN_EXPENSIVE_TESTS=$(RUN_EXPENSIVE_TESTS) \
$(PROVE) $(PROVE_FLAGS) $(TEST_FILES)
-test-single :: config_file $(ZEBRA_CONF_FILES) $(SCRIPTS)
+test-single :: $(KOHA_CONF_FILES) $(ZEBRA_CONF_FILES) $(SCRIPTS)
KOHA_CONF=$(TEST_CONF_FILE) PERL5LIB=$(PERL5LIB) RUN_EXPENSIVE_TESTS=1 SINGLE_TEST=1 \
$(PROVE) $(PROVE_FLAGS) -Ilib $(TEST_FILES)
@@ -105,7 +105,7 @@ $(SMOLDER_REPORT_TARBALL) :: $(SMOLDER_REPORT_FILENAME)
$(SMOLDER_REPORT_FILENAME) :: report
-report :: config_file $(ZEBRA_CONF_FILES) $(SCRIPTS)
+report :: $(KOHA_CONF_FILES) $(ZEBRA_CONF_FILES) $(SCRIPTS)
-KOHA_CONF=$(TEST_CONF_FILE) PERL5LIB=$(PERL5LIB) TEST_CLASS=$(TEST_CLASS) RUN_EXPENSIVE_TESTS=$(RUN_EXPENSIVE_TESTS) \
$(PERL) $(TEST_FILES) > $(SMOLDER_REPORT_FILENAME)
--
1.5.6
More information about the Koha-patches
mailing list