File Coverage

blib/lib/Log/LTSV/Instance.pm
Criterion Covered Total %
statement 68 73 93.1
branch 15 20 75.0
condition 6 7 85.7
subroutine 16 20 80.0
pod 7 9 77.7
total 112 129 86.8


line stmt bran cond sub pod time code
1             package Log::LTSV::Instance;
2 2     2   1498 use 5.008001;
  2         7  
3 2     2   11 use strict;
  2         3  
  2         57  
4 2     2   20 use warnings;
  2         3  
  2         69  
5 2     2   1600 use Time::Piece;
  2         1939118  
  2         12  
6 2     2   1841 use File::RotateLogs;
  2         103768  
  2         93  
7 2     2   2168 use Data::Dumper;
  2         16085  
  2         190  
8 2     2   19 use Carp;
  2         2  
  2         143  
9 2     2   1359 use Log::LTSV::Instance::Flatten;
  2         6  
  2         1949  
10              
11             our $VERSION = "0.04";
12              
13             my %LOG_LEVEL_MAP = (
14             DEBUG => 1,
15             INFO => 2,
16             WARN => 3,
17             CRITICAL => 4,
18             ERROR => 99,
19             );
20              
21             sub new {
22 14     14 1 45469 my ($class, %args) = @_;
23              
24 14   100     78 my $level = $LOG_LEVEL_MAP{$args{level} || 'DEBUG'};
25              
26 14 50       30 Carp::croak("level required ERROR or CRITICAL or WARN or INFO or DEBUG") unless $level;
27              
28 14         14 my ($logger, $rotatelogs);
29 14 100       34 if ($args{logger}) {
    50          
30 13         21 $logger = $args{logger};
31             } elsif (not defined $args{logfile}) {
32 0     0   0 $logger = sub { print @_ };
  0         0  
33             } else {
34             my $rotatelogs = File::RotateLogs->new(
35             logfile => $args{logfile},
36             $args{maxage} ? ( maxage => $args{maxage} ) : (),
37             $args{linkname} ? ( linkname => $args{linkname} ) : (),
38 1 50       35 $args{rotationtime} ? ( rotationtime => $args{rotationtime} ) : (),
    50          
    50          
39             );
40 1     1   311 $logger = sub { $rotatelogs->print(@_) };
  1         7  
41             }
42              
43 14         78 my $flatten = Log::LTSV::Instance::Flatten->new;
44              
45             bless {
46             rotatelogs => $rotatelogs,
47             logger => $logger,
48             level => $level,
49             sticks => {},
50 14   100     167 default_key => $args{default_key} || 'message',
51             _flatten => $flatten,
52             }, $class;
53             }
54              
55 0     0 1 0 sub error { shift->print('ERROR', @_) }
56 10     10 1 70 sub crit { shift->print('CRITICAL', @_) }
57 0     0 1 0 sub warn { shift->print('WARN', @_) }
58 0     0 1 0 sub info { shift->print('INFO', @_) }
59 2     2 1 13 sub debug { shift->print('DEBUG', @_) }
60              
61             sub sticks {
62 3     3 1 18 my ($self, @args) = @_;
63 3         10 while (@args) {
64 3         9 my ($key, $value) = splice @args, 0, 2;
65 3         13 $self->{sticks}{$key} = $value;
66             }
67             }
68              
69             sub _escape {
70 18     18   28 my ($self, $val) = @_;
71              
72 18         39 $val =~ s/\t/\\t/;
73 18         24 $val =~ s/\n/\\n/;
74              
75 18         43 return $val;
76             }
77              
78             sub labeled_values {
79 16     16 0 22 my ($self, $key, $value) = @_;
80 16         62 my %lv = $self->{_flatten}->flatten($key, $value);
81 16         99 $lv{$_} = $self->_escape($lv{$_}) for ( keys %lv );
82 16         25 map { join ':', $_, $lv{$_} } keys %lv;
  18         95  
83             }
84              
85             sub print {
86 12     12 0 29 my ($self, $level, @args) = @_;
87 12 100       46 return if ($LOG_LEVEL_MAP{$level} < $self->{level});
88              
89 11 100 66     136 if (ref $args[0] eq 'HASH') {
    100          
90 1         2 @args = %{ $args[0] };
  1         3  
91             } elsif ( scalar @args == 1 && ref $args[0] eq '' ) {
92 2         6 @args = ( $self->{default_key} => $args[0] );
93             }
94              
95 11         15 my @msgs;
96              
97 11         53 push @msgs, sprintf("time:%s", localtime->datetime);
98 11         1466 push @msgs, "log_level:$level";
99              
100 11         19 for my $key (keys %{ $self->{sticks} }) {
  11         51  
101 3         5 my $value = $self->{sticks}->{$key};
102 3 100       11 $value = $value->() if ref $value;
103 3         19 push @msgs, $self->labeled_values($key, $value);
104             }
105              
106 11         57 while (@args) {
107 13         33 my ($key, $value) = splice @args, 0, 2;
108 13         36 push @msgs, $self->labeled_values($key, $value);
109             }
110 11         28 my $ltsv = join "\t", @msgs;
111 11         51 $self->{logger}->($ltsv."\n");
112             }
113              
114             1;
115             __END__