File Coverage

blib/lib/Dancer2/Logger/Console/Colored.pm
Criterion Covered Total %
statement 69 83 83.1
branch 31 44 70.4
condition 3 17 17.6
subroutine 19 24 79.1
pod 0 4 0.0
total 122 172 70.9


line stmt bran cond sub pod time code
1             package Dancer2::Logger::Console::Colored;
2             # ABSTRACT: Dancer2 colored console logger.
3             #
4             # This file is part of Dancer2-Logger-Console-Colored
5             #
6             # This software is Copyright (c) 2014 by BURNERSK .
7             #
8             # This is free software, licensed under:
9             #
10             # The MIT (X11) License
11             #
12              
13             BEGIN {
14 2     2   102049 our $VERSION = '0.007'; # VERSION: generated by DZP::OurPkgVersion
15             }
16              
17 2     2   619 use Term::ANSIColor;
  2         8696  
  2         186  
18 2     2   531 use Moo;
  2         10921  
  2         15  
19 2     2   2421 use Dancer2::Core::Types qw( ArrayRef HashRef Str );
  2         142195  
  2         42  
20 2     2   4377 use Encode;
  2         9938  
  2         182  
21              
22             extends 'Dancer2::Logger::Console';
23              
24 2     2   1078 use namespace::clean;
  2         22894  
  2         14  
25              
26             has colored_origin => (
27             is => 'rw',
28             isa => Str,
29             );
30              
31             has colored_levels => (
32             is => 'rw',
33             isa => HashRef [Str],
34             default => sub { {} },
35             );
36              
37             has colored_messages => (
38             is => 'rw',
39             isa => HashRef [Str],
40             default => sub { {} },
41             );
42              
43             has colored_regex => (
44             is => 'rw',
45             isa => ArrayRef [ HashRef [Str] ],
46             default => sub { [] },
47             );
48              
49             sub colorize_origin {
50 48     48 0 101 my ( $self, $string ) = @_;
51              
52             # Configured color.
53 48 100       825 return colored( $string, $self->colored_origin ) if $self->colored_origin;
54              
55             # Default colors.
56 27         201 return colored( $string, 'cyan' );
57             }
58              
59             sub colorize_level {
60 16     16 0 36 my ( $self, $level ) = @_;
61 16         53 my $level_tmp = $level =~ s/\s+//gr;
62 16 50       48 $level_tmp = 'warning' if $level_tmp eq 'warn';
63              
64             # Configured color.
65 16 100       292 return colored( $level, $self->colored_levels->{$level_tmp} ) if $self->colored_levels->{$level_tmp};
66              
67             # Default colors.
68 9 100       75 return colored( $level, 'bold bright_white' ) if $level_tmp eq 'core';
69 8 100       27 return colored( $level, 'bold bright_blue' ) if $level_tmp eq 'debug';
70 6 100       21 return colored( $level, 'bold green' ) if $level_tmp eq 'info';
71 4 100       14 return colored( $level, 'bold yellow' ) if $level_tmp eq 'warning';
72 2 50       10 return colored( $level, 'bold yellow on_red' ) if $level_tmp eq 'error';
73 0         0 return colored( $level, 'bold magenta' );
74             }
75              
76             sub colorize_message {
77 16     16 0 46 my ( $self, $level, $message ) = @_;
78 16         64 my $level_tmp = $level =~ s/\s+//gr;
79 16 50       53 $level_tmp = 'warning' if $level_tmp eq 'warn';
80              
81             # Check for regex match.
82 16         26 foreach my $pattern ( @{ $self->colored_regex } ) {
  16         343  
83 3 100       40 if ($message =~ m/$pattern->{re}/) {
84 2         24 $message =~ s{($pattern->{re})}{colored($1, $pattern->{color} )}eg;
  3         47  
85 2         74 return $message;
86             }
87             }
88              
89             # Configured color.
90 14 100       295 return colored( $message, $self->colored_messages->{$level_tmp} ) if $self->colored_messages->{$level_tmp};
91              
92             # Default colors.
93 9 100       73 return colored( $message, 'bold bright_white' ) if $level_tmp eq 'core';
94 8 100       24 return colored( $message, 'bold bright_blue' ) if $level_tmp eq 'debug';
95 6 100       22 return colored( $message, 'bold green' ) if $level_tmp eq 'info';
96 4 100       14 return colored( $message, 'bold yellow' ) if $level_tmp eq 'warning';
97 2 50       11 return colored( $message, 'bold yellow on_red' ) if $level_tmp eq 'error';
98 0         0 return colored( $message, 'bold magenta' );
99             }
100              
101             # This comes original from Dancer2::Logger::Console. There are a few hooks
102             # required in order to colorize log messages properly.
103             sub format_message {
104 17     17 0 230759 my ( $self, $level, $message ) = @_;
105 17         43 chomp $message;
106              
107 17         64 $level = sprintf( '%5s', $level );
108 17 50       72 $message = Encode::encode( $self->auto_encoding_charset, $message )
109             if $self->auto_encoding_charset;
110              
111 17         141 my @stack = caller(8);
112 17         54 my $request = $self->request;
113 17         38 my $config = $self->config;
114              
115             my $block_handler = sub {
116 0     0   0 my ( $block, $type ) = @_;
117 0 0       0 if ( $type eq 't' ) {
    0          
118             return Encode::decode(
119 0   0     0 $config->{'charset'} || 'UTF-8',
120             POSIX::strftime( $block, localtime(time) )
121             );
122             }
123             elsif ( $type eq 'h' ) {
124 0   0     0 return ( $request && $request->header($block) ) || '-';
125             }
126             else {
127 0         0 Carp::carp("{$block}$type not supported");
128 0         0 return "-";
129             }
130 17         85 };
131              
132             my $chars_mapping = {
133 16     16   56 a => sub { $self->colorize_origin( $self->app_name ) },
134             t => sub {
135             Encode::decode(
136 1   50 1   57 $config->{'charset'} || 'UTF-8',
137             POSIX::strftime( "%d/%b/%Y %H:%M:%S", localtime(time) )
138             );
139             },
140 16     16   934 T => sub { POSIX::strftime( "%Y-%m-%d %H:%M:%S", localtime(time) ) },
141             u => sub {
142             Encode::decode(
143 0   0 0   0 $config->{'charset'} || 'UTF-8',
144             POSIX::strftime( "%d/%b/%Y %H:%M:%S", gmtime(time) )
145             );
146             },
147 0     0   0 U => sub { POSIX::strftime( "%Y-%m-%d %H:%M:%S", gmtime(time) ) },
148 16     16   79 P => sub { $$ },
149 16     16   39 L => sub { $self->colorize_level($level) },
150 16     16   44 m => sub { $self->colorize_message( $level => $message ) },
151 16   50 16   51 f => sub { $self->colorize_origin( $stack[1] || '-' ) },
152 16   50 16   64 l => sub { $self->colorize_origin( $stack[2] || '-' ) },
153             h => sub {
154 0   0 0   0 $self->colorize_origin(
155             ( $request && ( $request->remote_host || $request->address ) ) || '-'
156             )
157             },
158 0 0 0 0   0 i => sub { ( $request && $request->id ) || '-' },
159 17         278 };
160              
161             my $char_mapping = sub {
162 113     113   234 my $char = shift;
163              
164 113         207 my $cb = $chars_mapping->{$char};
165 113 50       238 if ( !$cb ) {
166 0         0 Carp::carp "\%$char not supported.";
167 0         0 return "-";
168             }
169 113         232 $cb->($char);
170 17         69 };
171              
172 17         345 my $fmt = $self->log_format;
173              
174 17         196 $fmt =~ s/
175             (?:
176             \%\{(.+?)\}([a-z])|
177             \%([a-zA-Z])
178             )
179 113 50       3209 / $1 ? $block_handler->($1, $2) : $char_mapping->($3) /egx;
180              
181 17         1835 return $fmt . "\n";
182             }
183              
184             1;
185              
186             __END__