Beefy Boxes and Bandwidth Generously Provided by pair Networks
Just another Perl shrine
 
PerlMonks  

Multiplexing log output: Log4perl of the poors

by Discipulus (Deacon)
on Oct 21, 2013 at 07:03 UTC ( #1059075=CUFP: print w/ replies, xml ) Need Help??

The 'Cool users for Perl' is a little intimidating for this snippet..
I was writing a program with the strictly use of core modules only and i was thinking to add the log functionality.

I looked at Log4Perl and wow... what a suit of features!I decided to try replicate some features: first the multiplexing of the output.

To use this you need to declare two hashes: the first is for handlers. It contains as key as you wont. Every key contains a three elements array: the glob of an already opened filehandle, the error level for this handler, and an anounymous sub to compose the final logline for this handler. Theese subs will receive two elements: the level and the message (ERROR, 'Cannot read').

The second hash is a dispatch table that merely filter unwanted message for a particular handler.

The small sub do an ugly cut on the incoming message and call some code for each handler defined.

As good side note you can change the level of an handler at runtime.

Comments and improvement welcome.

#!perl use strict; use warnings; $|++; # open some FH you'll use, handler 0 now is the already opened STDOUT open (LOG, '>','log-multiple-output.log') || die; open (BIGLOG, '>>','biglog.log') || die; # handlers: GLOB, LEVEL, COMPOSITION SUB receiving $lvl, $msg my %loghdl = ( 0 => [ *STDOUT, 'ERROR', sub{ return $_[0]."> $_[1]\n"}, ], 1 => [ *LOG, 'INFO', sub{my(undef, undef, $line) = caller(2); return $_[0].">".(scalar localtime(time)).' "'.$_[1].'" lin +e '.$line."\n"}], 2 => [ *BIGLOG, 'ERROR', sub{my(undef, undef, $line) = caller(2); return $_[0].">".(scalar localtime(time)).' "'.$_[1].'" lin +e '.$line."\n"}], ); # the filters declaration my %wanted =( DEBUG => sub { my ($to,$dbglvl,$action) = (shift,shift,s +hift); grep (/$dbglvl/,qw(DEBUG)) ? print $to $ac +tion->(@_) : 0; }, INFO => sub { my ($to,$dbglvl,$action) = (shift,shift,sh +ift); grep (/$dbglvl/,qw(DEBUG INFO)) ? print $t +o $action->(@_) : 0; }, WARNING => sub { my ($to,$dbglvl,$action) = (shift,shift,sh +ift); grep (/$dbglvl/,qw(DEBUG INFO WARNING)) ? +print $to $action->(@_) : 0; }, ERROR => sub { my ($to,$dbglvl,$action) = (shift,shift,s +hift); grep (/$dbglvl/,qw(DEBUG INFO WARNING ERRO +R)) ? print $to $action->(@_) : 0; }, FATAL => sub { my ($to,$dbglvl,$action) = (shift,shift,s +hift); grep (/$dbglvl/,qw(DEBUG INFO WARNING ERRO +R FATAL)) ? print $to $action->(@_) : 0; }, ); ## the sub cut the head of the incoming string sub ulog { my $msg = shift; chomp $msg; (my $cmd = $msg)=~s/\s+.*//g; $msg=~s/^$cmd\s+//; $cmd = uc $cmd; foreach my $hdl (sort keys %loghdl) { exists $wanted{$cmd} ? $wanted{$cmd}->( @{$loghdl{$hdl}},$cmd,$msg) : print {$loghdl{$hdl}->[0]} 'Unknown logevel>'.lc ($cmd).' '.( +lc ($cmd) eq $msg ? '' : $msg)."\n"; } } #EXAMPLE of use ulog 'Eccolo qui'; ulog ('DEBUG debbuuuugga'); ulog ('Debug debbuuuugga'); ulog ('INFO infohere'); ulog ('WARNING warn!! you are not authorized'); ulog ('ERROR unable to read'); ulog ('FATAL cannot find Perl..'); print "\nchanging lvl to debug..\n\n"; $loghdl{0}->[1]='DEBUG'; ulog 'eccolo qui'; ulog ('DEBUG debbuuuugga'); ulog ('debug debbuuuugga'); ulog ('INFO infohere'); ulog ('WARNING warn!! you are not authorized'); ulog ('ERROR unable to read'); ulog ('FATAL cannot find Perl..');
I hope someone can find this useful.

L*
There are no rules, there are no thumbs..
Reinvent the wheel, then learn The Wheel; may be one day you reinvent one of THE WHEELS.

Comment on Multiplexing log output: Log4perl of the poors
Download Code

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others cooling their heels in the Monastery: (9)
As of 2014-07-10 10:25 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    When choosing user names for websites, I prefer to use:








    Results (206 votes), past polls