A couple of weeks ago, I posted RFC: A simple and badly-named logging module. Given the feedback and a few days to ponder on it, I decided I had approached a number of things in a flawed manner, prompting a re-write from scratch.
The goals haven't changed. The goals were:
- An interface that doesn't get in the way of "real" code.
- Automagical logging of die/warn events
- Easy configuration, in as few lines of code as possible.
- Pure perl
- Suitable and reasonable defaults.
I will address three likely classes of comments off the bat. First, I used Exporter. Yes, I know that "Exporter is evil" to many people, and the fact that I used a custom import function that forces the core subroutines into to be exported will also tickle a few noses. However, given the goals, I think it was the right approach.
Second, I used prototypes on the exported functions. I have my reasons: I wanted the debug/trace/info statements to work in the same way as warn/die do. Consistency of interface trumped prototype concerns, and I think this is one of the few cases where they are sensible.
Third, I'm sure some will see this as "reinventing the wheel" and ask why I didn't just use an existing logger. I addressed this in detail in the previous RFC, but I'll summarize here: things like Log::Simple and Log::Log4Perl are great. The former fills a great niche, and the latter is extremely powerful. It came down to the fact that I wanted something in-between for certain applications, and which satisfied the goals above.
This RFC is one the steps along the way for me to release this on CPAN, so please pay particular attention to anything that would prevent you from using this in production code.
Thanks in advance!
Jump to code
$Id: Painless.pod,v 1.1 2006-02-27 09:58:51 radiant Exp $
$Revision: 1.1 $
This document describes the Log::Painless module.
Log::Painless (hereafter, LP) is a module designed to allow reasonably
configurable, yet painless logging. Everything from reasonable defaults to
the interface, to the configuration system is meant to be as painless as
possible without sacrificing too much functionality.
This module abuses Exporter to create the info, debug, and trace
subroutines in the importing package. There is no way to turn this off: it's
kind of the whole point.
Warnings and exceptions are handled via signal handlers
attached to the perl built-in functions warn and die. See
SIGNAL HANDLERS for more on these.
Examples:
#!/bin/perl
use Log::Painless; # sends warnings, info, and exceptions to m
+ain.log
info "Logging begun";
warn "Hello, there!"; #behaves like warn, but logs warning as
+well.
die "Program done."; #behaves like die, but logs exception as
+ well.
LP is configured during import (see CONFIGURATION):
use Log::Painless { file => 'myscript.log', level => 'debug' }
+;
Any logging calls that are supressed by the current logging level are empty
subs, so performance should not be impacted by peppering code with trace
calls.
There are also three shortcuts (enter, leave, caught) imported by
default to make tracing/debugging easier:
use Log::Painless { level => 'debug' };
sub test_log {
debug enter; # puts 'Entered subroutine main::test_log' t
+o log
eval {
# .. something which could die..
};
if ($@) {
# logs 'Caught exception [$@] 1 evals deep in main::tes
+t_log'
info caught;
# .. handle the exception
}
debug leave; # as enter, above, but "Left subroutine"
}
test_log();
The caught call removes the 'at file.pl line ##.' from the caught exception
message, for clarity.
- info
-
info 'Starting to connect to data source: '.$dsn;
-
Records an info-level log message.
-
Takes one scalar argument as a message to record to the log. This and all
other exported functions are prototyped so that only one argument will be
accepted (and parentheses are not required) -- this is much like the behavior
of the functions warn and die.
- debug
-
As info, bug for debug-level messages. More verbose than info, less verbose
than trace.
- trace
-
As info, but for trace-level messages. Most verbose level, should be used
for extremely detailed information only.
- caught
-
A shortcut that returns a string indicating that an exception was caught, and
providing information about the nature and location of the caught exception.
This is intended to be paired with a logging statement. The exception will
still be logged. For example:
-
eval {
$dbh = DBI->connect('dbi:SQLite2:dbname=test.db','',''
+) or
die ("Can't connect!");
};
if ($@) {
info caught;
warn "Falling back to CSV file..."
# do stuff.
}
-
Might result in the following log:
-
2006-03-14T13:21:32 4508 E (myscript.pl/11):Can't connect!
2006-03-14T13:21:32 4508 I Caught exception [Can't connect!] 1
+ evals deep in main
2006-03-14T13:21:32 4508 W (myscript.pl/16):Falling back to CS
+V file...
-
Note that nested evals are noted, and either the package name or the subroutine
that generates the exception is noted.
- enter
-
A shortcut that returns a message string indicating entry into the calling
subroutine. This is intended to be paired with a logging statement. For example:
-
sub test_sub {
trace enter;
# .. some stuff
}
-
Might result in a the following log:
-
2006-03-14T13:21:33 4509 T Entered subroutine main::test_sub
-
Note that the package name is included.
- leave
-
A shorcut in the style of enter, but provides a 'Left subroutine' message:
-
sub test_sub {
# .. some stuff
trace leave;
}
-
Might result in a the following log:
-
2006-03-14T13:21:35 4509 T Left subroutine main::test_sub
Almost all configuration is done during import by passing a single hashref.
The exceptions to this rule are covered in DUPLICATING AND DIVERTING LOGS.
Following are the options for import-time configuration:
- file
-
The default logging destination. This may be either a filehandle typeglob
(e.g. *STDERR) or a file name. If a file name, the file will be opened
for appending, and created if it does not exist. If a handle, LP will assume
that it is already open for writing.
-
By default, it is the package name followed by '.log';
-
use Log::Painless { file => 'messages.log' };
- level
-
The maximum level of detail to record in any log. Levels are literal strings:
exception, warning, info, debug, trace (in order of increasing
detail). The default level is 'info'.
-
use Log::Painless { level => 'debug' }; # only trace will be s
+upressed
- timeformat
-
A format string for the Date-Time stamp on each message, in the
POSIX::strftime manner. The default is an ISO8601 format.
- logformat
-
A format string in the sprintf manner. This controls how the log lines
appear. The default is '%s %d %s %s'; the order of format codes is
Date-Time, PID, Type-Char, Message. See LOGFILE FORMAT for more
information.
- lineformat
-
An optional CODEref for reformatting the log line before it is written to disk.
The CODEref must accept the preformatted line as its first parameter, and
return the line to be written to disk. See LOGFILE FORMAT for more
information.
- shortcuts
-
A list of shortcuts to be exported. By default, all three shortcuts (enter,
leave, and caught) are exported. This option allows the implementor to
avoid exporting one or more of these by specifying the ones s?he wants
imported.
-
use Log::Painless { shortcuts => [ 'caught' ] }; # only import
+ caught()
- quiet_warn
-
When set, supressess passing of warnings to CORE::warn. By default, this
is unset, and warnings behave as usual, with logging as appropriate. See
SIGNAL HANDLERS for more details.
Using only import-time configuration, only one log file may be used. However,
it is commonly useful to have particular classes of messages be directed to
separate log files. For example, an implementor may wish to have all debug
messages directed to a file named 'debug.log'.
LP supports this functionality through runtime configuration, allowing
specific-level messages to be duplicated to several logs or diverted to a
separate log.
For example, to divert all debug-level messages to 'debug.log':
Log::Painless->divert('debug' => 'debug.log');
Either a filehandle typeglob or filename may be given to divert. In some
cases, an implementor wishes to duplicate messages to a secondary target:
Log::Painless->duplicate('debug' => *STDERR);
This will log all debug messages as previously configured, but also log them
to STDERR. This call can be repeated to cause messages to be written to a
theoretically limitless number of logs. Duplicating to more than two or three
targets is, though, strongly discouraged for practical reasons.
These calls can be sensibly combined, as well. For example, if the default
log target is 'main.log', but debug messages are to go only to 'debug.log' and
STDERR:
Log::Painless->divert('debug' => 'debug.log');
Log::Painless->duplicate('debug' => *STDERR);
It's worth noting that divert will disable all previous targets for the
given message level.
Warnings and exceptions are handled via overriding the signal handlers for
the built-in warn and die functions. That is, $SIG{__WARN__} and
$SIG{__DIE__} are universally overridden. If there are signal handlers
already existing at import time, these will be automatically chained onto
the logging handlers.
For warnings, CORE::warn will be called to propagate warnings unless
quiet_warn is set. For exceptions, CORE::die will be called for
propagation under all circumstances. This means all calls to die -- even
those inside eval{} blocks -- will be logged. It is a good idea to use
caught to note when such exceptions are handled internally.
To preserve logging capabilities when overriding these handlers at runtime,
merely chain them:
use Log::Painless;
{
my $old_warn = $SIG{__WARN__};
$SIG{__WARN__} = sub {
# my own signal handling;
$old_warn->(@_);
};
}
See perlvar under %SIG for more details about this.
The logfile format is:
Date-Time PID Type-Char Message
With default format settings, this results in something like:
2006-03-14T14:22:32 4856 E (testlog.pl/10):the death
The Type-Char is one of Trace, Debug, Info, Warning, Exception.
The line format may be altered through the logformat and timeformat
configuration directives. Additionally, the lineformat directive can be
used to specify a CODEref that will reformat each log line before it is
written.
For example, to elimitate the PID from the log:
use Log::Painless {
lineformat => sub { my $m = shift; $m=~s/^(.*?) \d+/$1
+/; return $m },
};
Any newlines found within Message are converted to the ASCII Field Separator
char (0x1F).
Copyright (c) 2006 Darren Meyer <darren.meyer@gmail.com>
Permission is hereby granted, free of charge, to any person obtaining a copy of
this software and associated documentation files (the ``Software''), to deal in
the Software without restriction, including without limitation the rights to
use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
of the Software, and to permit persons to whom the Software is furnished to do
so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in all
copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED ``AS IS'', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
SOFTWARE.
package Log::Painless;
#=====================================================================
+==========
# $Id: Painless.pm,v 1.1 2006-02-27 09:58:51 radiant Exp $
# Painless, simple logging facility
#---------------------------------------------------------------------
+----------
# (c) 2006 RadiantMatrix, under an MIT License (see LICENSE doc sectio
+n)
#=====================================================================
+==========
use strict;
#use warnings;
#__Modules__#
require Exporter;
use Fcntl;
use IO::Handle;
use Data::Dumper ();
use POSIX qw[strftime];
use vars qw[@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION];
#__setup__#
$VERSION = sprintf "%d.%03d", q$Revision: 1.1 $ =~ /: (\d+)\.(\d+)/;
+ #CVS
@ISA = qw[Exporter];
@EXPORT = qw[info debug trace];
@EXPORT_OK = qw[enter leave caught];
my %Config;
my %Lvl = ( trace => 5, debug => 4, info => 3, warning => 2, exception
+ => 1 );
#__configuration and import__#
my $LE = "\n";
# ( $^O eq 'MSWin32' ? "\x0D\x0A" : "\x0A" ); #Win line endings or
+ Unix?
sub trace ($) { }
sub debug ($) { }
sub info ($) { }
#_____________________________________________________________________
+ import()_
sub import {
# import ( \%config )
my $self = shift;
my $config = shift;
(my $dlog = caller().'.log') =~ s/\W+/_/g;
my %default = (
file => $dlog,
level => 'info',
logformat => '%s %d %s %s',
timeformat => '%Y-%m-%dT%H:%M:%S',
shortcuts => [ qw(enter leave caught) ],
quiet_warn => 0,
);
foreach (keys %default) {
$config->{$_} = $default{$_} unless exists $config->{$_};
}
unless ( exists $Lvl{ $config->{level} } ) {
die "Bad log level: $$config{level}" ;
}
no warnings 'redefine';
foreach ( sort { $Lvl{$a} <=> $Lvl{$b} } keys %Lvl ) {
$Config{$_}{files} = [];
$self->divert( $_ => $config->{file} );
if ($Lvl{$config->{level}} >= $Lvl{$_}) {
eval '*'.$_.'=\&_'.$_.';';
}
else {
eval '*'.$_.'=\&_empty;';
}
}
for (qw [logformat timeformat lineformat level quiet_warn] ) {
$Config{$_} = $config->{$_} if exists $config->{$_};
}
my ($sig_warn, $sig_die) = ($SIG{__WARN__}, $SIG{__DIE__});
$SIG{__WARN__} = sub {
CORE::warn(@_) unless $Config{quiet_warn};
warning ( @_ );
if (defined $sig_warn && ref $sig_warn eq 'CODE') { $sig_warn-
+>(@_) }
};
$SIG{__DIE__} = sub {
exception( @_ );
if (defined $sig_die && ref $sig_die eq 'CODE') { $sig_die->(@
+_) }
};
$self->export_to_level(1, $self, @EXPORT);
if (defined $config->{shortcuts}) {
$self->export_to_level(1, $self, @{ $config->{shortcuts} } );
}
}
#__________________________________________________________________ du
+plicate()_
sub duplicate {
# duplicate ( %cfg )
my $self = shift;
my %cfg = @_;
foreach ( keys %cfg ) {
next unless exists $Config{$_}{files};
my $fh;
if ( $cfg{$_} =~ /^\*/ ) {
$fh = $cfg{$_};
# die("handle not open for writing while duplicating log '$
+_'")
# unless ( O_WRONLY | O_RDWR ) & fcntl( $fh, F_GETFL, my
+$slush );
}
else {
open $fh, '>>', $cfg{$_}
or die("Can't append to $cfg{$_} while duplicating log '
+$_'");
}
autoflush $fh 1;
push @{ $Config{$_}{files} }, $fh;
}
return 1;
}
#_____________________________________________________________________
+ divert()_
sub divert {
# divert ( %cfg )
my $self = shift;
my %cfg = @_;
my %sav;
foreach ( keys %cfg ) {
next unless exists $Config{$_}{files};
$sav{$_} = $Config{$_}{files} unless exists $sav{$_};
my $fh;
if ( $cfg{$_} =~ /^\*/ ) {
$fh = $cfg{$_};
# die("handle not open for writing while diverting log '$_'
+")
# unless ( O_WRONLY | O_RDWR ) & fcntl( $fh, F_GETFL, my
+$slush );
}
else {
open $fh, '>>', $cfg{$_}
or die("Can't append to $cfg{$_} while diverting log '$_
+'");
}
autoflush $fh 1;
$Config{$_}{files} = [$fh];
}
return \%sav;
}
#_____________________________________________________________________
+ _write()_
sub _write {
# _write ( $level, $msg )
my ( $level, $msg ) = @_;
$msg =~ s/[\r\n]/\x1F/g; # change line-breaks to field-seps.
my $line = sprintf $Config{'logformat'},
strftime($Config{'timeformat'}, localtime),
$$, uc substr($level,0,1), $msg;
# call global custom formater if it exists
$line = $Config{'lineformat'}->($line)
if ( exists $Config{'lineformat'}
&& ref $Config{'lineformat'} eq 'CODE' );
# call level custom formater if it exists
$line = $Config{$level}{'lineformat'}->($line)
if ( exists $Config{$level}{'lineformat'}
&& ref $Config{$level}{'lineformat'} eq 'CODE' );
# write to log
for ( @{ $Config{$level}{files} } ) {
print $_ $line,$LE;
}
return 1;
}
#__ shortcuts __#
#_____________________________________________________________________
+_ enter()_
sub enter () {
# enter ( ) - generates a sub entrance message.
my ($pack, $file, $line, $sub) = caller(1);
return 'Entered subroutine '.$sub;
}
#_____________________________________________________________________
+_ leave()_
sub leave () {
# leave ( ) - generates a sub departure message.
my ($pack, $file, $line, $sub) = caller(1);
return 'Left subroutine '.$sub;
}
#_____________________________________________________________________
+ caught()_
sub caught () {
# caught ( ) - invoked as, e.g. info caught;
my $cl = 1;
my ($pack, $file, $sub);
do {
($pack,$file, undef, $sub) = caller($cl++);
} until ($sub ne '(eval)');
$cl--;
(my $exc = $@) =~ s/(.*) at .*$/$1/s; #trim of 'at file line ##' m
+sg.
$exc=~ s/[\r\n]/\x1F/gs; #replace line endings.
return 'Caught exception ['.$exc.'] '
.($cl>0 ? "$cl evals deep " : '').'in '
.($sub ? $sub : 'main');
}
#_____________________________________________________________________
+ _empty()_
sub _empty ($) { } # executed when a log level is to be skipped
#__ interfaces __#
#_____________________________________________________________________
+ _trace()_
sub _trace ($) {
# trace ( $msg )
_write('trace', @_)
}
#_____________________________________________________________________
+ _debug()_
sub _debug ($) {
# debug ( $msg )
_write('debug', @_)
}
#_____________________________________________________________________
+ _info()_
sub _info ($) {
# info ( $msg )
_write('info', @_)
}
#___________________________________________________________________ _
+warning()_
sub _warning ($) {
# warning ( $msg )
(my $msg = shift) =~ m/(.*)\s+at (.*?) line (\d+).*$/;
_write('warning', "($2\/$3):$1");
#- CORE::warn($msg) if ($Lvl{$Config{level}} >= $Lvl{warning});
}
#_________________________________________________________________ _ex
+ception()_
sub _exception ($) {
# exception ( $msg )
(my $msg = shift) =~ m/(.*)\s+at (.*?) line (\d+).*$/;
_write('exception', "($2\/$3):$1");
CORE::die($msg);
}
1;
Updates:
- 2006-03-15 : Cleaned up some POD markup
Re: RFC: Log::Painless
by xdg (Monsignor) on Mar 15, 2006 at 17:17 UTC
|
I think this is an improvement over the last. However, I really don't like the automatic importing of so many functions, particularly enter, leave and caught. I really think those should be optional. Consider the potential confusion of using this module next to Exception::Class which might be using it's own caught method! There's no real reason why you can't support variations like this:
use Log::Painless qw( :ALL ) { %opts };
use Log::Painless qw( :STD ) { %opts };
use Log::Painless qw( :NONE ) { %opts };
use Log::Painless qw( debug info ) { %opts };
It's fine to have your own import, but it would be great -- even if you automatically import a few functions -- to allow users to turn that off if they want.
Also, while a minor point, I'd rather see the Pod follow a more standard format, with the abstract describing the module, not the document, with the synopsis being just a short amount of code, and what you wrote in the synopsis being retitled to "Description" or "Usage".
-xdg
Code written by xdg and posted on PerlMonks is public domain. It is provided as is with no warranties, express or implied, of any kind. Posted code may not have been tested. Use of posted code is at your own risk.
| [reply] [d/l] [select] |
|
However, I really don't like the automatic importing of so many functions, particularly enter, leave and caught.
Actually, I agreed with you from the beginning. Those three functions can be excluded from import, or selectively imported:
use Log::Painless { shortcuts => [] };
#or
use Log::Painless { shortcuts => ['enter','leave'] };
This is in the documentation, but I admit it doesn't jump out. I'd be happy to hear suggestions on how to make the document more clear.
The end result is only really three functions are exported in a mandatory way: info, debug and trace. I will certainly give some thought to controlling the export of these -- my gut says that you must have these three available, but perhaps they could be aliased as the code author sees fit?
I will take your POD suggestions and reorganize a bit before publishing to CPAN.
Thanks for the response!
| [reply] [d/l] [select] |
Re: RFC: Log::Painless
by rhesa (Vicar) on Mar 15, 2006 at 18:07 UTC
|
Looks like you might benefit from Sub::Exporter. That way, people can alias your methods into names they like, so they can avoid clashes.
Other than that, it does look pretty nice; I like the way you intercept warnings and exceptions, although I wonder how well that plays with CGI::Carp, or Error other such modules.
But I'm going to stick with Log::Dispatch; I absolutely adore its features and plugins. Couldn't imagine life without Log::Dispatch::File::Rolling or Log::Dispatch::Email::MIMELite to direct my log messages. | [reply] |
|
Thanks for the pointer on Sub::Exporter. Providing a custom-naming convention for imported routines is an interesting idea, and one I will be pursuing further (though maybe not in the initial release).
Signal handlers *are* always tricky. If a module like CGI::Carp takes similar steps to "play nice", as I have, all should be ok, since I try to chain any pre-existing signal handlers. If they don't, then it's a matter of import order: if Log::Painless is imported last, it should record the log entry first, then call out to pre-existing ones.
I've been struggling with how to mitigate these issues... perhaps I will simply allow the user to turn off the warn/die interception, with the caveat that warnings and exceptions would then have to be logged "by hand" through calling the exception and warning subs (which would have to be imported, then). I'm definitely open to suggestions on how to handle this -- it's got me a bit stumped.
I do like Log::Dispatch, and I don't think Log::Painless would ever compete with it -- slightly different niche, I think.
| [reply] [d/l] [select] |
Re: RFC: Log::Painless
by PodMaster (Abbot) on Mar 16, 2006 at 09:35 UTC
|
| [reply] |
|
Hm. After almost a year of using Log::Log4Perl, I never noticed the :easy mode. Interesting, thank you.
When I first looked at the doc you linked, I thought "yes, I should just subclass this." I mentioned it to a personal friend of mine, though, and was reminded how often my Perl code ends up linked into Windows EXEs and PAR files; perhaps it's best to not require the fairly large Log::Log4Perl and dependencies unless I actually need its power.
So, it looks like I have a fork before I have a release: I put the creation of Log::Log4Easy, which will be a Log::Painless style interface to the :easy mode of Log::Log4Perl, on my to-do list. Fortunately, I have a temporary excess of round tuits, so expect another RFC in the next couple of weeks.
| [reply] [d/l] [select] |
|
|