File Coverage

blib/lib/Log/Dispatch/Colorful.pm

Criterion	Covered	Total	%
statement	65	66	98.4
branch	9	16	56.2
condition	2	5	40.0
subroutine	15	15	100.0
pod	3	3	100.0
total	94	105	89.5

package Log::Dispatch::Colorful;

use strict;
use warnings;

use base qw( Log::Dispatch::Output );

use Data::Dumper;
use Log::Dispatch::Output;
use Params::Validate qw(validate BOOLEAN SCALAR ARRAYREF CODEREF);
use Term::ANSIColor;

Params::Validate::validation_options( allow_extra => 1 );

our $VERSION = '0.03';

our %LEVELS;

BEGIN {
    foreach my $level (qw( debug info notice warning err error crit critical alert emerg emergency )) {
        my $sub = sub {
            my $self = shift;
            my $messages;
            foreach my $arg (@_) {
                if ( ref $arg ) {
                    $messages = Dumper($arg);
                }
                $messages .= $arg || '';
            }

            $self->log( level => $level, message => $messages );
        };

        $LEVELS{$level} = 1;

        no strict 'refs';
        no warnings 'redefine';
        *{ "Log::Dispatch::" . $level } = $sub;
    }
}

sub new {
    my $proto = shift;
    my $class = ref $proto || $proto;

    my %p = validate(
        @_,
        {   stderr => {
                type    => BOOLEAN,
                default => 1
            },
        }
    );

    my $self = bless {}, $class;

    $self->_basic_init(%p);

    $self->{color}  = exists $p{color}  ? $p{color}  : {};
    $self->{stderr} = exists $p{stderr} ? $p{stderr} : 1;

    my @collbacks = $self->_get_callbacks(%p);
    unshift @collbacks, sub {
        my %p = @_;

        if ( $self->{color}->{ $p{level} }->{text} ) {
            $p{message} = color( $self->{color}->{ $p{level} }->{text} ) . $p{message} . color('reset');
        }

        if ( $self->{color}->{ $p{level} }->{background} ) {
            $p{message} = color( 'on_' . $self->{color}->{ $p{level} }->{background} ) . $p{message} . color('reset');
        }

        $p{message};
    };

    $self->{callbacks} = \@collbacks;

    return $self;
}

sub log {
    my $self = shift;

    my %p = validate( @_, { level => { type => SCALAR }, } );

    return unless $self->_should_log( $p{level} );

    $p{message} = $self->_apply_callbacks(%p)
        if $self->{callbacks};

    $self->log_message(%p);
}

sub log_message {
    my $self = shift;
    my %p    = @_;

    if ( $self->{stderr} ) {
        print STDERR $p{message};
    }
    else {
        print STDOUT $p{message};
    }
}

1;
__END__