Beefy Boxes and Bandwidth Generously Provided by pair Networks
No such thing as a small change
 
PerlMonks  

RFC: Log::Painless

by radiantmatrix (Parson)
on Mar 15, 2006 at 16:58 UTC ( #536876=perlmeditation: print w/ replies, xml ) Need Help??

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:

  1. An interface that doesn't get in the way of "real" code.
  2. Automagical logging of die/warn events
  3. Easy configuration, in as few lines of code as possible.
  4. Pure perl
  5. 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 $


NAME

This document describes the Log::Painless module.


SYNOPSIS

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.


FUNCTIONS

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


CONFIGURATION

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.


DUPLICATING AND DIVERTING LOGS

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.


SIGNAL HANDLERS

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.


LOGFILE FORMAT

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).


LICENSE

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

<-radiant.matrix->
A collection of thoughts and links from the minds of geeks
The Code that can be seen is not the true Code
I haven't found a problem yet that can't be solved by a well-placed trebuchet

Comment on RFC: Log::Painless
Select or Download Code
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.

      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!

      <-radiant.matrix->
      A collection of thoughts and links from the minds of geeks
      The Code that can be seen is not the true Code
      I haven't found a problem yet that can't be solved by a well-placed trebuchet
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.

      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.

      <-radiant.matrix->
      A collection of thoughts and links from the minds of geeks
      The Code that can be seen is not the true Code
      I haven't found a problem yet that can't be solved by a well-placed trebuchet
Re: RFC: Log::Painless
by PodMaster (Abbot) on Mar 16, 2006 at 09:35 UTC
    ...It came down to the fact that I wanted something in-between for certain applications, and which satisfied the goals above.
    You may have already considered this, but your module is very similar to Log4perl's :easy mode, so much so that maybe you should consider subclassing Log::Log4perl for your implementation.

    What's the easiest way to use Log4perl?

    MJD says "you can't just make shit up and expect the computer to know what you mean, retardo!"
    I run a Win32 PPM repository for perl 5.6.x and 5.8.x -- I take requests (README).
    ** The third rule of perl club is a statement of fact: pod is sexy.

      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.

      <-radiant.matrix->
      A collection of thoughts and links from the minds of geeks
      The Code that can be seen is not the true Code
      I haven't found a problem yet that can't be solved by a well-placed trebuchet

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlmeditation [id://536876]
Approved by xdg
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others studying the Monastery: (5)
As of 2014-10-02 03:39 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    What is your favourite meta-syntactic variable name?














    Results (46 votes), past polls