File Coverage

blib/lib/Dancer/Logger/ColorConsole.pm
Criterion Covered Total %
statement 15 75 20.0
branch 0 24 0.0
condition 0 24 0.0
subroutine 5 20 25.0
pod 2 2 100.0
total 22 145 15.1


line stmt bran cond sub pod time code
1             package Dancer::Logger::ColorConsole;
2 1     1   22798 use strict;
  1         2  
  1         41  
3 1     1   6 use warnings;
  1         1  
  1         31  
4 1     1   6 use base 'Dancer::Logger::Abstract';
  1         5  
  1         1016  
5 1     1   203116 use Dancer::Config 'setting';
  1         3  
  1         50  
6 1     1   1128 use Term::ANSIColor;
  1         9546  
  1         1194  
7              
8             our $VERSION = '0.0005';
9              
10             sub _log {
11 0     0     my ($self, $level, $message) = @_;
12 0           print STDERR $self->format_message($level => $message);
13             }
14              
15             sub init {
16 0     0 1   my $self = shift;
17 0           $self->SUPER::init(@_);
18              
19 0           my $config = setting('engines')->{logger};
20              
21 0           $self->{level_colors} = $config->{levels};
22              
23 0   0       $self->{level_colors}{core} ||= 'reset';
24 0   0       $self->{level_colors}{debug} ||= 'bright_blue';
25 0   0       $self->{level_colors}{warn} ||= $self->{level_colors}{warning} || 'bright_yellow';
      0        
26 0   0       $self->{level_colors}{error} ||= 'bright_red';
27 0   0       $self->{level_colors}{info} ||= 'bright_green';
28              
29 0 0 0       if (!exists($config->{default_regexps}) || $config->{default_regexps} != 0) {
30 0           push @{$self->{regexps}} =>
  0            
31             (
32             { re => 'response: 2\d\d', color => 'bright_green' },
33             { re => 'response: [45]\d\d', color => 'bright_red' },
34             { re => '(?:GET|POST|PUT|DELETE) \S+', color => 'bright_blue' },
35             );
36             }
37              
38 0 0 0       if (exists($config->{regexps}) && ref($config->{regexps}) eq 'ARRAY') {
39 0           push @{$self->{regexps}} => @{$config->{regexps}};
  0            
  0            
40             }
41              
42             }
43              
44             sub format_message {
45 0     0 1   my ($self, $level, $message) = @_;
46 0           chomp $message;
47              
48 0 0         if (setting('charset')) {
49 0           $message = Encode::encode(setting('charset'), $message);
50             }
51              
52 0 0         $level = 'warn' if $level eq 'warning';
53 0           $level = color($self->{level_colors}{$level}) . sprintf('%5s', $level);
54              
55 0           my $r = Dancer::SharedData->request;
56 0           my @stack = caller(3);
57              
58             my $block_handler = sub {
59 0     0     my ( $block, $type ) = @_;
60 0 0         if ( $type eq 't' ) {
    0          
61 0           return "[" . strftime( $block, localtime ) . "]";
62             }
63             elsif ( $type eq 'h' ) {
64 0   0       return scalar $r->header($block) || '-';
65             }
66             else {
67 0           Carp::carp("{$block}$type not supported");
68 0           return "-";
69             }
70 0           };
71              
72             my $chars_mapping = {
73             h => sub {
74 0 0 0 0     defined $r
75             ? $r->env->{'HTTP_X_REAL_IP'} || $r->env->{'REMOTE_ADDR'}
76             : '-';
77             },
78 0     0     t => sub { Encode::decode(setting('charset'),
79             POSIX::strftime( "%d/%b/%Y %H:%M:%S", localtime )) },
80 0     0     T => sub { POSIX::strftime( "%Y-%m-%d %H:%M:%S", localtime ) },
81 0     0     P => sub { $$ },
82 0     0     L => sub { $level },
83             D => sub {
84 0     0     my $time = Dancer::SharedData->timer->tick;
85 0           return $time;
86             },
87 0     0     m => sub { $message },
88 0 0   0     f => sub { $stack[1] || '-' },
89 0 0   0     l => sub { $stack[2] || '-' },
90             i => sub {
91 0 0   0     defined $r ? "[hit #" . $r->id . "]" : "";
92             },
93 0           };
94              
95             my $char_mapping = sub {
96 0     0     my $char = shift;
97              
98 0           my $cb = $chars_mapping->{$char};
99 0 0         unless ($cb) {
100 0           Carp::carp "\%$char not supported.";
101 0           return "-";
102             }
103 0           $cb->($char);
104 0           };
105              
106 0           my $fmt = $self->_log_format();
107              
108 0           $fmt =~ s{
109             (?:
110             \%\{(.+?)\}([a-z])|
111             \%([a-zA-Z])
112             )
113 0 0         }{ $1 ? $block_handler->($1, $2) : $char_mapping->($3) }egx;
114              
115 0           for my $re (@{$self->{regexps}}) {
  0            
116 0           $fmt =~ s/($re->{re})/colored($1, $re->{color})/ge;
  0            
117             }
118              
119 0           return $fmt . color('reset') . "\n";
120             }
121              
122              
123             1;
124              
125             __END__