File Coverage

blib/lib/Log/Log4Cli.pm

Criterion	Covered	Total	%
statement	36	38	94.7
branch	23	28	82.1
condition	9	9	100.0
subroutine	19	19	100.0
pod	11	11	100.0
total	98	105	93.3

package Log::Log4Cli;

use 5.006;
use strict;
use warnings;
use parent qw(Exporter);

use Carp qw(croak);
use Term::ANSIColor qw(colored);

our $VERSION = '0.19'; # Don't forget to change in pod below

our @EXPORT = qw(
    die_fatal
    die_info
    die_alert
    die_notice

    log_fd

    log_fatal
    log_error
    log_alert
    log_notice
    log_warn
    log_info
    log_debug
    log_trace
);

our $COLORS = {
    FATAL  => 'bold red',
    ERROR  => 'red',
    ALERT  => 'bold yellow',
    WARN   => 'yellow',
    INFO   => 'cyan',
    DEBUG  => 'blue',
    TRACE  => 'magenta'
};
$COLORS->{NOTICE} = $COLORS->{ALERT}; # Deprecated

our $LEVEL = 0;
our $POSITIONS = undef;
my $FD = \*STDERR;       # descriptor
our $COLOR = -t $FD;     # color on/off switcher

sub _die($$$$) {
    if ($^S) {
        # inside eval block
        croak defined $_[3] ? "$_[3]" : "Died";
    } else {
        print $FD $_[2] . (defined $_[3] ? "$_[3]. " : "") .
            "Exit $_[0], ET " . (time - $^T) . "s\n" if ($_[1]);
        exit $_[0];
    }
}

sub _pfx($) {
    my ($S, $M, $H, $d, $m, $y) = localtime(time);
    my $pfx = sprintf "[%04i-%02i-%02i %02i:%02i:%02i %i %5s] ",
        $y + 1900, $m + 1, $d, $H, $M, $S, $$, $_[0];
    return ($COLOR ? colored($pfx, $COLORS->{$_[0]}) : $pfx) .
        (($POSITIONS or $LEVEL > 4) ? join(":", (caller(1))[1,2]) . " " : "");
}

sub die_fatal(;$;$) { _die $_[1] || 127, $LEVEL > -2, _pfx('FATAL'), $_[0] }
sub die_alert(;$;$) { _die $_[1] || 0,   $LEVEL > -1, _pfx('ALERT'), $_[0] }
*die_notice = \&die_alert; # Deprecated
sub die_info(;$;$)  { _die $_[1] || 0,   $LEVEL >  1, _pfx('INFO'),  $_[0] }

sub log_fatal(&) { print $FD _pfx('FATAL') . $_[0]->($_) . "\n" if $LEVEL > -2 }
sub log_error(&) { print $FD _pfx('ERROR') . $_[0]->($_) . "\n" if $LEVEL > -1 }
sub log_alert(&) { print $FD _pfx('ALERT') . $_[0]->($_) . "\n" if $LEVEL > -1 }
*log_notice = \&log_alert; # Deprecated
sub log_warn(&)  { print $FD _pfx('WARN')  . $_[0]->($_) . "\n" if $LEVEL >  0 }
sub log_info(&)  { print $FD _pfx('INFO')  . $_[0]->($_) . "\n" if $LEVEL >  1 }
sub log_debug(&) { print $FD _pfx('DEBUG') . $_[0]->($_) . "\n" if $LEVEL >  2 }
sub log_trace(&) { print $FD _pfx('TRACE') . $_[0]->($_) . "\n" if $LEVEL >  3 }

sub log_fd(;$) {
    if (@_) {
        $FD = shift;
        $COLOR = -t $FD;
    }
    return $FD;
}

1;

__END__