File Coverage

blib/lib/Log/Log4Cli.pm

Criterion	Covered	Total	%
statement	54	54	100.0
branch	30	30	100.0
condition	11	11	100.0
subroutine	25	25	100.0
pod	11	11	100.0
total	131	131	100.0

package Log::Log4Cli;

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

use Term::ANSIColor qw(colored);

BEGIN {
    *CORE::GLOBAL::die = sub {
        my $msg = join(' ', grep { defined } @_) || "Died";
        $msg .= " at " . join(' line ', (caller)[1,2]);
        &die_fatal($msg, 255);
    };
}

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

our @EXPORT = qw(
    die_fatal
    die_info
    die_alert

    log_fd

    log_fatal
    log_error
    log_alert
    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'
};

our $LEVEL = 0;
our $POSITIONS = undef;
our $COLOR;              # color on/off switcher; defined below
our $STATUS = undef;     # exit code; deprecated TODO: remove it

my $FD;                  # descriptor to write messages; defined below

sub _die($$$$) {
    my $log_msg = $_[2] . (defined $_[3] ? "$_[3]. " : "") .
        "Exit $_[0], ET " . (time - $^T) . "s\n";

    if ($^S) {
        # inside eval block
        $STATUS = $_[0]; # deprecated TODO: remove it

        my ($file, $line) = (caller(1))[1,2];
        CORE::die bless {
            ERR_MESSAGE => ($_[3] ? "$_[3]" : "Died") . " at $file line $line.",
            EXIT_CODE => $_[0],
            FILE => $file,
            LINE => $line,
            LOG_MESSAGE => $_[1] ? $log_msg : '',
        }, 'Log::Log4Cli::Exception';
    } else {
        print $FD $log_msg 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] }
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 }
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;
}

log_fd(\*STDERR);

1;

package Log::Log4Cli::Exception;

use 5.006;
use strict;
use warnings;

use overload '""' => \&as_string;

sub as_string {
    $_[0]->{ERR_MESSAGE};
}

1;

__END__