File Coverage

blib/lib/Log/Dispatch/Screen/Color.pm

Criterion	Covered	Total	%
statement	48	48	100.0
branch	10	12	83.3
condition	6	9	66.6
subroutine	9	9	100.0
pod	0	2	0.0
total	73	80	91.2

package Log::Dispatch::Screen::Color;
use strict;
use warnings;
use base 'Log::Dispatch::Screen';
our $VERSION = '0.04';

use Params::Validate qw(validate HASHREF BOOLEAN);
Params::Validate::validation_options( allow_extra => 1 );

use Term::ANSIColor ();
require Win32::Console::ANSI if $^O eq 'MSWin32';

our $DEFAULT_COLOR = {
    debug => {},
    info  => {
        text       => 'blue',
        background => undef,
    },
    notice  => {
        text       => 'green',
        background => undef,
    },
    warning  => {
        text       => 'black',
        background => 'yellow',
    },
    error  => {
        text       => 'red',
        background => 'yellow',
    },
    critical  => {
        text       => 'black',
        background => 'red',
    },
    alert  => {
        text       => 'white',
        background => 'red',
        bold       => 1,
    },
    emergency  => {
        text       => 'yellow',
        background => 'red',
        bold       => 1,
    },
};
$DEFAULT_COLOR->{err}   = $DEFAULT_COLOR->{error};
$DEFAULT_COLOR->{crit}  = $DEFAULT_COLOR->{critical};
$DEFAULT_COLOR->{emerg} = $DEFAULT_COLOR->{emergency};


sub new {
    my $proto = shift;
    my $self  = $proto->SUPER::new(@_);

    my %p = validate( @_, {
        color => {
            type     => HASHREF,
            optional => 1,
            default  => +{},
        },
        newline => {
            type => BOOLEAN,
            optional => 1,
            default => 0,
        },
    });

    # generate color table
    my $color = {};
    while (my($level, $val) = each %{ $DEFAULT_COLOR }) {
        my $obj = $p{color}->{$level} || $val;
        $color->{$level} = {
            text       => $obj->{text},
            background => $obj->{background},
            bold       => $obj->{bold},
        };
    }
    $self->{color} = $color;

    # inject color callback
    my @callbacks      = $self->_get_callbacks(%p);
    $self->{callbacks} = [ sub { $self->colored(@_) }, @callbacks ];

    # newline
    if ($p{newline}) {
        push @{$self->{callbacks}}, \&_add_newline_callback;
    }

    $self;
}

my $RESET = Term::ANSIColor::color('reset');
my $BOLD  = Term::ANSIColor::color('bold');
my %COLOR_CACHE;
sub colored {
    my($self, %p) = @_;
    my $message = $p{message};
    my $level   = $p{level};
    return $message unless $level;
    my $map     = $self->{color}->{$level};
    return $message unless $map;

    if (my $name = $map->{text}) {
        my $color = $COLOR_CACHE{$name} ||= Term::ANSIColor::color($name);
        $message = join '', $color, $message, $RESET;
    }
    if (my $name = $map->{background}) {
        my $color = $COLOR_CACHE{"on_$name"} ||= Term::ANSIColor::color("on_$name");
        $message = join '', $color, $message, $RESET;
    }
    if ($map->{bold}) {
        $message = join '', $BOLD, $message, $RESET;
    }

    return $message;
}

sub _add_newline_callback {
    my %p = @_;
    return $p{message} . "\n";
}


1;
__END__