File Coverage

blib/lib/Dancer2/Logger/Console/Colored.pm

Criterion	Covered	Total	%
statement	60	70	85.7
branch	31	40	77.5
condition	2	4	50.0
subroutine	16	18	88.8
pod	0	4	0.0
total	109	136	80.1

package Dancer2::Logger::Console::Colored;
# ABSTRACT: Dancer2 colored console logger.
#
# This file is part of Dancer2-Logger-Console-Colored
#
# This software is Copyright (c) 2014 by BURNERSK .
#
# This is free software, licensed under:
#
#   The MIT (X11) License
#

BEGIN {
  our $VERSION = '0.006'; # VERSION: generated by DZP::OurPkgVersion
}

use Term::ANSIColor;
use Moo;
use Dancer2::Core::Types qw( ArrayRef HashRef Str );

extends 'Dancer2::Logger::Console';

has colored_origin => (
  is  => 'rw',
  isa => Str,
);

has colored_levels => (
  is      => 'rw',
  isa     => HashRef [Str],
  default => sub { {} },
);

has colored_messages => (
  is      => 'rw',
  isa     => HashRef [Str],
  default => sub { {} },
);

has colored_regex => (
  is      => 'rw',
  isa     => ArrayRef [ HashRef [Str] ],
  default => sub { [] },
);

sub colorize_origin {
  my ( $self, $string ) = @_;

  # Configured color.
  return colored( $string, $self->colored_origin ) if $self->colored_origin;

  # Default colors.
  return colored( $string, 'cyan' );
}

sub colorize_level {
  my ( $self, $level ) = @_;
  my $level_tmp = $level =~ s/\s+//gr;
  $level_tmp = 'warning' if $level_tmp eq 'warn';

  # Configured color.
  return colored( $level, $self->colored_levels->{$level_tmp} ) if $self->colored_levels->{$level_tmp};

  # Default colors.
  return colored( $level, 'bold bright_white' )  if $level_tmp eq 'core';
  return colored( $level, 'bold bright_blue' )   if $level_tmp eq 'debug';
  return colored( $level, 'bold green' )         if $level_tmp eq 'info';
  return colored( $level, 'bold yellow' )        if $level_tmp eq 'warning';
  return colored( $level, 'bold yellow on_red' ) if $level_tmp eq 'error';
  return colored( $level, 'bold magenta' );
}

sub colorize_message {
  my ( $self, $level, $message ) = @_;
  my $level_tmp = $level =~ s/\s+//gr;
  $level_tmp = 'warning' if $level_tmp eq 'warn';

  # Check for regex match.
  foreach my $pattern ( @{ $self->colored_regex } ) {
    if ($message =~ m/$pattern->{re}/) {
      $message =~ s{($pattern->{re})}{colored($1, $pattern->{color} )}eg;
      return $message;
    }
  }

  # Configured color.
  return colored( $message, $self->colored_messages->{$level_tmp} ) if $self->colored_messages->{$level_tmp};

  # Default colors.
  return colored( $message, 'bold bright_white' )  if $level_tmp eq 'core';
  return colored( $message, 'bold bright_blue' )   if $level_tmp eq 'debug';
  return colored( $message, 'bold green' )         if $level_tmp eq 'info';
  return colored( $message, 'bold yellow' )        if $level_tmp eq 'warning';
  return colored( $message, 'bold yellow on_red' ) if $level_tmp eq 'error';
  return colored( $message, 'bold magenta' );
}

# This comes original from Dancer2::Logger::Console. There are a few hooks
# required in order to colorize log messages propably.
sub format_message {
  my ( $self, $level, $message ) = @_;
  chomp $message;

  $level = sprintf( '%5s', $level );
  $message = Encode::encode( $self->auto_encoding_charset, $message )
    if $self->auto_encoding_charset;

  my @stack = caller(8);

  my $block_handler = sub {
    my ( $block, $type ) = @_;
    if ( $type eq 't' ) {
      return "[" . strftime( $block, localtime(time) ) . "]";
    }
    else {
      Carp::carp("{$block}$type not supported");
      return "-";
    }
  };

  my $chars_mapping = {
    a => sub { $self->colorize_origin( $self->app_name ) },
    t => sub {
      Encode::decode(
        setting('charset'),
        POSIX::strftime( "%d/%b/%Y %H:%M:%S", localtime(time) ) );
    },
    T => sub { POSIX::strftime( "%Y-%m-%d %H:%M:%S", localtime(time) ) },
    P => sub { $$ },
    L => sub { $self->colorize_level($level) },
    m => sub { $self->colorize_message( $level => $message ) },
    f => sub { $self->colorize_origin( $stack[1] || '-' ) },
    l => sub { $self->colorize_origin( $stack[2] || '-' ) },
  };

  my $char_mapping = sub {
    my $char = shift;

    my $cb = $chars_mapping->{$char};
    if ( !$cb ) {
      Carp::carp "\%$char not supported.";
      return "-";
    }
    $cb->($char);
  };

  my $fmt = $self->log_format;

  $fmt =~ s/
        (?:
            \%\{(.+?)\}([a-z])|
            \%([a-zA-Z])
        )
    / $1 ? $block_handler->($1, $2) : $char_mapping->($3) /egx;

  return $fmt . "\n";
}

1;

__END__