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   1411 use 5.008001;
  2         8  
3 2     2   11 use strict;
  2         2  
  2         41  
4 2     2   17 use warnings;
  2         3  
  2         48  
5 2     2   1737 use Time::Piece;
  2         27387  
  2         15  
6 2     2   2577 use File::RotateLogs;
  2         96585  
  2         65  
7 2     2   2081 use Data::Dumper;
  2         13104  
  2         126  
8 2     2   14 use Carp;
  2         4  
  2         104  
9 2     2   1250 use Log::LTSV::Instance::Flatten;
  2         6  
  2         1845  
10              
11             our $VERSION = "0.05";
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 41667 my ($class, %args) = @_;
23              
24 14   100     83 my $level = $LOG_LEVEL_MAP{$args{level} || 'DEBUG'};
25              
26 14 50       32 Carp::croak("level required ERROR or CRITICAL or WARN or INFO or DEBUG") unless $level;
27              
28 14         23 my ($logger, $rotatelogs);
29 14 100       37 if ($args{logger}) {
    50          
30 13         24 $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       36 $args{rotationtime} ? ( rotationtime => $args{rotationtime} ) : (),
    50          
    50          
39             );
40 1     1   269 $logger = sub { $rotatelogs->print(@_) };
  1         7  
41             }
42              
43 14         73 my $flatten = Log::LTSV::Instance::Flatten->new;
44              
45             bless {
46             rotatelogs => $rotatelogs,
47             logger => $logger,
48             level => $level,
49             sticks => {},
50 14   100     137 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 72 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         8 while (@args) {
64 3         8 my ($key, $value) = splice @args, 0, 2;
65 3         16 $self->{sticks}{$key} = $value;
66             }
67             }
68              
69             sub _escape {
70 18     18   28 my ($self, $val) = @_;
71              
72 18         37 $val =~ s/\t/\\t/g;
73 18         25 $val =~ s/\n/\\n/g;
74              
75 18         52 return $val;
76             }
77              
78             sub labeled_values {
79 16     16 0 26 my ($self, $key, $value) = @_;
80 16         62 my %lv = $self->{_flatten}->flatten($key, $value);
81 16         76 $lv{$_} = $self->_escape($lv{$_}) for ( keys %lv );
82 16         32 map { join ':', $_, $lv{$_} } keys %lv;
  18         157  
83             }
84              
85             sub print {
86 12     12 0 30 my ($self, $level, @args) = @_;
87 12 100       43 return if ($LOG_LEVEL_MAP{$level} < $self->{level});
88              
89 11 100 66     55 if (ref $args[0] eq 'HASH') {
    100          
90 1         2 @args = %{ $args[0] };
  1         4  
91             } elsif ( scalar @args == 1 && ref $args[0] eq '' ) {
92 2         7 @args = ( $self->{default_key} => $args[0] );
93             }
94              
95 11         18 my @msgs;
96              
97 11         40 push @msgs, sprintf("time:%s", localtime->datetime);
98 11         1118 push @msgs, "log_level:$level";
99              
100 11         15 for my $key (keys %{ $self->{sticks} }) {
  11         41  
101 3         6 my $value = $self->{sticks}->{$key};
102 3 100       13 $value = $value->() if ref $value;
103 3         21 push @msgs, $self->labeled_values($key, $value);
104             }
105              
106 11         53 while (@args) {
107 13         31 my ($key, $value) = splice @args, 0, 2;
108 13         34 push @msgs, $self->labeled_values($key, $value);
109             }
110 11         26 my $ltsv = join "\t", @msgs;
111 11         46 $self->{logger}->($ltsv."\n");
112             }
113              
114             1;
115             __END__