File Coverage

blib/lib/CPAN/MirrorMerger/Logger.pm
Criterion Covered Total %
statement 27 39 69.2
branch 3 4 75.0
condition n/a
subroutine 9 12 75.0
pod 0 6 0.0
total 39 61 63.9


line stmt bran cond sub pod time code
1             package CPAN::MirrorMerger::Logger;
2 2     2   203962 use strict;
  2         7  
  2         47  
3 2     2   8 use warnings;
  2         4  
  2         52  
4              
5 2     2   428 use Class::Accessor::Lite ro => [qw/level/], new => 1;
  2         1049  
  2         11  
6              
7 2     2   658 use Data::Dumper ();
  2         5478  
  2         38  
8 2     2   740 use Time::Moment;
  2         2631  
  2         621  
9              
10             my %LEVEL_MAP = (
11             error => 1000,
12             warn => 500,
13             info => 100,
14             debug => 10,
15             );
16              
17 0     0 0 0 sub write_log { require Carp; Carp::croak('abstruct method') }
  0         0  
18              
19             sub format_log {
20 6     6 0 13 my ($self, $now, $level, $msg, $attr) = @_;
21 6 50       15 unless (defined $attr) {
22 6         79 return sprintf '%s [%s] %s', $now->to_string(), uc $level, $msg;
23             }
24              
25 0         0 my $attr_str = do {
26 0         0 local $Data::Dumper::Terse = 1;
27 0         0 local $Data::Dumper::Indent = 0;
28 0         0 local $Data::Dumper::Sortkeys = 1;
29 0         0 Data::Dumper::Dumper($attr);
30             };
31 0         0 return sprintf '%s [%s] %s (%s)', $now->to_string(), uc $level, $msg, $attr_str;
32             }
33              
34             sub _log {
35 18     18   36 my ($self, $level, $msg, $attr) = @_;
36 18 100       45 return if $LEVEL_MAP{$level} < $LEVEL_MAP{$self->level};
37              
38 6         60 my $now = Time::Moment->now_utc();
39 6         17 my $payload = $self->format_log($now, $level, $msg, $attr);
40 6         30 $self->write_log($payload);
41             }
42              
43             sub error {
44 0     0 0 0 my ($self, $msg, $attr) = @_;
45 0         0 $self->_log(error => $msg, $attr);
46             }
47              
48             sub warn {
49 0     0 0 0 my ($self, $msg, $attr) = @_;
50 0         0 $self->_log(warn => $msg, $attr);
51             }
52              
53             sub info {
54 6     6 0 58 my ($self, $msg, $attr) = @_;
55 6         16 $self->_log(info => $msg, $attr);
56             }
57              
58             sub debug {
59 12     12 0 1030 my ($self, $msg, $attr) = @_;
60 12         26 $self->_log(debug => $msg, $attr);
61             }
62              
63             1;
64             __END__