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..');
[download]

I hope someone can find this useful.

L*

---

---

Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!

Titles consisting of a single word are discouraged, and in most cases are disallowed outright.

Read Where should I post X? if you're not absolutely sure you're posting in the right place.

Please read these before you post! —

• How do I compose an effective node title?
• How do I post a question effectively?
• Markup in the Monastery

Posts may use any of the Perl Monks Approved HTML tags:

a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr

You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)

	For:		Use:
	&		&
	<		&lt;
	>		&gt;
	[		&#91;
	]		&#93;

Link using PerlMonks shortcuts! What shortcuts can I use for linking?

See Writeup Formatting Tips and other pages linked from there for more info.