view release on metacpan or  search on metacpan

lib/Log/Log4Cli.pm  view on Meta::CPAN

    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);

t/50-die.t  view on Meta::CPAN

BEGIN {
    *CORE::GLOBAL::exit = sub {
        $LAST_EXIT = $_[0];
    };
};

use Log::Log4Cli;
use Test::More;

sub get_logged(&) {
    my $logged;

    no warnings 'uninitialized'; # perl 5.8 fails with 'Use of uninitialized value in open'
    open(LOGGED,'>', \$logged) or die $!;
    log_fd(\*LOGGED);

    $_[0]->();

    close(LOGGED);