#!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].'" line '.$line."\n"}], 2 => [ *BIGLOG, 'ERROR', sub{my(undef, undef, $line) = caller(2); return $_[0].">".(scalar localtime(time)).' "'.$_[1].'" line '.$line."\n"}], ); # the filters declaration my %wanted =( DEBUG => sub { my ($to,$dbglvl,$action) = (shift,shift,shift); grep (/$dbglvl/,qw(DEBUG)) ? print $to $action->(@_) : 0; }, INFO => sub { my ($to,$dbglvl,$action) = (shift,shift,shift); grep (/$dbglvl/,qw(DEBUG INFO)) ? print $to $action->(@_) : 0; }, WARNING => sub { my ($to,$dbglvl,$action) = (shift,shift,shift); grep (/$dbglvl/,qw(DEBUG INFO WARNING)) ? print $to $action->(@_) : 0; }, ERROR => sub { my ($to,$dbglvl,$action) = (shift,shift,shift); grep (/$dbglvl/,qw(DEBUG INFO WARNING ERROR)) ? print $to $action->(@_) : 0; }, FATAL => sub { my ($to,$dbglvl,$action) = (shift,shift,shift); grep (/$dbglvl/,qw(DEBUG INFO WARNING ERROR 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..');