File Coverage

blib/lib/Log/Log4perl/Appender/ScreenColoredLevels/UsingMyColors.pm
Criterion Covered Total %
statement 22 44 50.0
branch 0 10 0.0
condition n/a
subroutine 8 11 72.7
pod 2 2 100.0
total 32 67 47.7


line stmt bran cond sub pod time code
1             package Log::Log4perl::Appender::ScreenColoredLevels::UsingMyColors;
2 1     1   761 use strict;
  1         2  
  1         29  
3              
4 1     1   5 use warnings;
  1         2  
  1         30  
5 1     1   4 no warnings;
  1         3  
  1         35  
6              
7 1     1   488 use subs qw();
  1         22  
  1         36  
8              
9             our $VERSION = '0.112';
10              
11 1     1   619 use Term::ANSIColor qw(:constants color colored);
  1         7212  
  1         1040  
12 1     1   601 use Log::Log4perl::Level;
  1         1629  
  1         4  
13              
14             =encoding utf8
15              
16             =head1 NAME
17              
18             Log::Log4perl::Appender::ScreenColoredLevels::UsingMyColors - Colorize messages according to level amd my colors
19              
20             =head1 SYNOPSIS
21              
22             use Log::Log4perl::Appender::ScreenColoredLevels::UsingMyColors;
23              
24             =head1 SYNOPSIS
25              
26             use Log::Log4perl qw(:easy);
27              
28             Log::Log4perl->init(\ <<'EOT');
29             log4perl.category = DEBUG, Screen
30             log4perl.appender.Screen = Log::Log4perl::Appender::ScreenColoredLevels::UsingMyColors
31             log4perl.appender.Screen.layout = Log::Log4perl::Layout::PatternLayout
32             log4perl.appender.Screen.layout.ConversionPattern = [%p] %d %F{1} %L> %m %n
33             log4perl.appender.Screen.color.trace = cyan
34             log4perl.appender.Screen.color.debug = default
35             log4perl.appender.Screen.color.info = green
36             log4perl.appender.Screen.color.warn = default
37             log4perl.appender.Screen.color.error = default
38             log4perl.appender.Screen.color.fatal = red
39             EOT
40              
41              
42             =head1 DESCRIPTION
43              
44             =over 4
45              
46             =item new
47              
48             =cut
49              
50             sub new {
51 0     0 1   my( $class, @options ) = @_;
52              
53             #print STDERR "Options are ", Dumper( \@options ), "\n";
54              
55 0           my $self = {
56             name => "unknown name",
57             stderr => 1,
58              
59             @options,
60             };
61              
62 0           my %trace_color;
63              
64 0           @trace_color{ qw(trace debug info error warn fatal) } = ( '' ) x 6;
65              
66 0           my %Allowed = map { $_, 1 } @{ $Term::ANSIColor::EXPORT_TAGS{constants} };
  0            
  0            
67              
68 0           foreach my $level ( qw( trace debug info error warn fatal) ) {
69 0 0         next unless exists $self->{color}{$level};
70 0 0         next if lc $self->{color}{$level} eq 'default';
71              
72 0           my @b = map { uc } split /\s+/, $self->{color}{$level};
  0            
73              
74 0           foreach my $b ( @b ) {
75 0 0         die "Illegal color $b" unless exists $Allowed{ $b };
76             }
77              
78 0           $trace_color{ $level } = $self->{color}{$level};
79             }
80              
81 0           $self->{trace_color} = \%trace_color;
82              
83 0           bless $self, $class;
84             }
85              
86             sub _trace_color {
87 0     0     my( $self, $level ) = @_;
88              
89 0 0         $self->{trace_color}{ lc $level } || '';
90             }
91              
92             =item log
93              
94             =cut
95              
96 1     1   445 BEGIN { $Term::ANSIColor::EACHLINE = "\n" };
97              
98             sub log {
99 0     0 1   my( $self, %params ) = @_;
100 1     1   14 no strict 'refs';
  1         3  
  1         88  
101              
102 0 0         print { $self->{stderr} ? *STDERR : select }
103             colored(
104             $params{message},
105             $self->_trace_color( $params{log4p_level} )
106 0           );
107              
108             }
109              
110             =back
111              
112             =head1 DESCRIPTION
113              
114             This appender acts like Log::Log4perl::Appender::ScreenColoredLevels, but
115             you get to choose the colors. You can choose any of the constants from
116             Term::ANSIColor.
117              
118             =head1 TO DO
119              
120              
121             =head1 SEE ALSO
122              
123             L, L
124              
125             =head1 SOURCE AVAILABILITY
126              
127             This source is on GitHub:
128              
129             https://github.com/briandfoy/log-log4perl-appender-screencoloredlevels-usingmycolors
130              
131             =head1 AUTHOR
132              
133             brian d foy, C<< >>
134              
135             =head1 COPYRIGHT AND LICENSE
136              
137             Copyright © 2008-2018, brian d foy . All rights reserved.
138              
139             You may redistribute this under the terms of the Artistic License 2.0.
140              
141             =cut
142              
143             1;