File Coverage

blib/lib/Log/Any/Adapter/Screen.pm

Criterion	Covered	Total	%
statement	17	69	24.6
branch	0	36	0.0
condition	0	26	0.0
subroutine	6	13	46.1
pod	0	3	0.0
total	23	147	15.6

package Log::Any::Adapter::Screen;

use 5.010001;
use strict;
use warnings;

use Log::Any;
use Log::Any::Adapter::Util qw(make_method);
use parent qw(Log::Any::Adapter::Base);

our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
our $DATE = '2023-11-21'; # DATE
our $DIST = 'Log-Any-Adapter-Screen'; # DIST
our $VERSION = '0.141'; # VERSION

my $CODE_RESET = "\e[0m"; # PRECOMPUTED FROM: do { require Term::ANSIColor; Term::ANSIColor::color('reset') }
my $DEFAULT_COLORS = {alert=>"\e[31m",critical=>"\e[31m",debug=>"",emergency=>"\e[31m",error=>"\e[35m",info=>"\e[32m",notice=>"\e[32m",trace=>"\e[33m",warning=>"\e[1;34m"}; # PRECOMPUTED FROM: do { require Term::ANSIColor; my $tmp = {trace=>'yellow', debug=>'', info=>'green',notice=>'green',warning=>'bold blue',error=>'magenta',critical=>'red',alert=>'red',emergency=>'red'}; for (keys %$tmp) { if ($tmp->{$_}) { $tmp->{$_} = Term::ANSIColor::color($tmp->{$_}) } }; $tmp }

my $Time0;

my @logging_methods = Log::Any->logging_methods;
our %logging_levels;
for my $i (0..@logging_methods-1) {
    $logging_levels{$logging_methods[$i]} = $i;
}
# some common typos
$logging_levels{warn} = $logging_levels{warning};

sub _min_level {
    my $self = shift;

    return $ENV{LOG_LEVEL}
        if $ENV{LOG_LEVEL} && defined $logging_levels{$ENV{LOG_LEVEL}};
    return 'trace' if $ENV{TRACE};
    return 'debug' if $ENV{DEBUG};
    return 'info'  if $ENV{VERBOSE};
    return 'error' if $ENV{QUIET};
    $self->{default_level};
}

sub init {
    my ($self) = @_;
    $self->{default_level} //= 'warning';
    $self->{stderr}    //= 1;
    $self->{use_color} //= do {
        if (exists $ENV{NO_COLOR}) {
            0;
        } elsif (defined $ENV{COLOR}) {
            $ENV{COLOR};
        } else {
            (-t STDOUT); ## no critic: InputOutput::ProhibitInteractiveTest
        }
    };
    if ($self->{colors}) {
        require Term::ANSIColor;
        # convert color names to escape sequence
        my $orig = $self->{colors};
        $self->{colors} = {
            map {($_,($orig->{$_} ? Term::ANSIColor::color($orig->{$_}) : ''))}
                keys %$orig
            };
    } else {
        $self->{colors} = $DEFAULT_COLORS;
    }
    $self->{min_level} = $self->{log_level} if(exists $self->{log_level} && ! exists $self->{min_level});
    delete $self->{log_level};
    $self->{min_level} //= $self->_min_level;
    if (!$self->{formatter}) {
        if (($ENV{LOG_PREFIX} // '') eq 'elapsed') {
            require Time::HiRes;
            $Time0 //= Time::HiRes::time();
        }
        $self->{formatter} = sub {
            my ($self, $msg) = @_;
            my $env = $ENV{LOG_PREFIX} // '';
            if ($env eq 'elapsed') {
                my $time = Time::HiRes::time();
                $msg = sprintf("[%9.3fms] %s", ($time - $Time0)*1000, $msg);
            }
            $msg;
        };
    }
    $self->{_fh} = $self->{stderr} ? \*STDERR : \*STDOUT;
}

sub hook_before_log {
    return;
    #my ($self, $msg) = @_;
}

sub hook_after_log {
    my ($self, $msg) = @_;
    print { $self->{_fh} } "\n" unless $msg =~ /\n\z/;
}

for my $method (Log::Any->logging_methods()) {
    make_method(
        $method,
        sub {
            my ($self, $msg) = @_;

            return if $logging_levels{$method} <
                $logging_levels{$self->{min_level}};

            $self->hook_before_log($msg);

            if ($self->{formatter}) {
                $msg = $self->{formatter}->($self, $msg);
            }

            if ($self->{use_color} && $self->{colors}{$method}) {
                $msg = $self->{colors}{$method} . $msg . $CODE_RESET;
            }

            print { $self->{_fh} } $msg;

            $self->hook_after_log($msg);
        }
    );
}

for my $method (Log::Any->detection_methods()) {
    my $level = $method; $level =~ s/^is_//;
    make_method(
        $method,
        sub {
            my $self = shift;
            $logging_levels{$level} >= $logging_levels{$self->{min_level}};
        }
    );
}

1;
# ABSTRACT: (ADOPTME) Send logs to screen, with colors and some other features

__END__