File Coverage

blib/lib/Log/ger/Layout/LTSV.pm
Criterion Covered Total %
statement 87 88 98.8
branch 43 48 89.5
condition 5 18 27.7
subroutine 11 11 100.0
pod 0 1 0.0
total 146 166 87.9


line stmt bran cond sub pod time code
1             package Log::ger::Layout::LTSV;
2              
3             our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
4             our $DATE = '2020-03-07'; # DATE
5             our $DIST = 'Log-ger-Layout-LTSV'; # DIST
6             our $VERSION = '0.004'; # VERSION
7              
8 1     1   3495 use 5.010001;
  1         3  
9 1     1   5 use strict;
  1         1  
  1         18  
10 1     1   4 use warnings;
  1         1  
  1         23  
11              
12 1     1   402 use Devel::Caller::Util;
  1         321  
  1         35  
13 1     1   5 use Log::ger ();
  1         2  
  1         15  
14 1     1   419 use Time::HiRes qw(time);
  1         1118  
  1         3  
15              
16             our $time_start = time();
17             our $time_now = $time_start;
18             our $time_last = $time_start;
19              
20             sub _encode {
21 5     5   8 my ($pkg, $msg) = @_;
22              
23 5         6 my @res;
24 5         21 for my $l (sort keys %$msg) {
25 25         37 my $val = $msg->{$l};
26 25         33 $l =~ s/[:\t\n]+/ /g;
27 25         36 $val =~ s/[\t\n]+/ /g;
28 25         50 push @res, "$l:$val";
29             }
30 5         37 join("\t", @res);
31             }
32              
33             sub _layout {
34 5     5   8 my $pkg = shift;
35 5         9 my ($plugin_conf, $msg0, $per_target_conf, $lnum, $level) = @_;
36              
37 5         39 ($time_last, $time_now) = ($time_now, time());
38 5         8 my %per_message_data;
39              
40             my $msg;
41 5 100       14 if (ref $msg0 eq 'HASH') {
42 3         10 $msg = {%$msg0};
43             } else {
44 2         6 $msg = {message => $msg0};
45             }
46              
47 5 100       14 if ($plugin_conf->{delete_fields}) {
48 1         2 for my $f (@{ $plugin_conf->{delete_fields} }) {
  1         4  
49 2 100       6 if (ref $f eq 'Regexp') {
50 1         3 for my $k (keys %$msg) {
51 2 100       10 delete $msg->{$k} if $k =~ $f;
52             }
53             } else {
54 1         2 delete $msg->{$f};
55             }
56             }
57             }
58              
59 5 100       11 if (my $ff = $plugin_conf->{add_fields}) {
60 1         3 for my $f (keys %$ff) {
61 1         3 $msg->{$f} = $ff->{$f};
62             }
63             }
64              
65 5 100       10 if (my $ff = $plugin_conf->{add_special_fields}) {
66 1         2 my %mentioned_specials;
67 1         4 for my $f (keys %$ff) {
68 15         22 $mentioned_specials{ $ff->{$f} }++;
69             }
70              
71 1 0 33     5 if (
      0        
      0        
72             $mentioned_specials{Class} ||
73             $mentioned_specials{File} ||
74             $mentioned_specials{Line} ||
75             $mentioned_specials{Location}
76             ) {
77             $per_message_data{caller0} =
78 1         6 [Devel::Caller::Util::caller (0, 0, $plugin_conf->{packages_to_ignore}, $plugin_conf->{subroutines_to_ignore})];
79             }
80 1 50 33     80 if (
81             $mentioned_specials{Location} ||
82             $mentioned_specials{Method}
83             ) {
84             $per_message_data{caller1} =
85 1         4 [Devel::Caller::Util::caller (1, 0, $plugin_conf->{packages_to_ignore}, $plugin_conf->{subroutines_to_ignore})];
86             }
87 1 50       77 if ($mentioned_specials{Stack_Trace}) {
88             $per_message_data{callers} =
89 1         4 [Devel::Caller::Util::callers(0, 0, $plugin_conf->{packages_to_ignore}, $plugin_conf->{subroutines_to_ignore})];
90             }
91              
92 1         138 for my $f (keys %$ff) {
93 15         18 my $sf = $ff->{$f};
94 15         17 my $val;
95 15 100       72 if ($sf eq 'Category') {
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    50          
96 1         5 $val = $per_target_conf->{category};
97             } elsif ($sf eq 'Class') {
98 1         2 $val = $per_message_data{caller0}[0];
99             } elsif ($sf eq 'Date_Local') {
100 1         43 my @t = localtime($time_now);
101 1         10 $val = sprintf(
102             "%04d-%02d-%02dT%02d:%02d:%02d",
103             $t[5]+1900, $t[4]+1, $t[3],
104             $t[2], $t[1], $t[0],
105             );
106             } elsif ($sf eq 'Date_GMT') {
107 1         8 my @t = gmtime($time_now);
108 1         7 $val = sprintf(
109             "%04d-%02d-%02dT%02d:%02d:%02d",
110             $t[5]+1900, $t[4]+1, $t[3],
111             $t[2], $t[1], $t[0],
112             );
113             } elsif ($sf eq 'File') {
114 1         2 $val = $per_message_data{caller0}[1];
115             } elsif ($sf eq 'Hostname') {
116 1         475 require Sys::Hostname;
117 1         924 $val = Sys::Hostname::hostname();
118             } elsif ($sf eq 'Location') {
119             $val = sprintf(
120             "%s (%s:%d)",
121             $per_message_data{caller1}[3] // '',
122             $per_message_data{caller0}[1],
123 1   50     7 $per_message_data{caller0}[2],
124             );
125             } elsif ($sf eq 'Line') {
126 1         3 $val = $per_message_data{caller0}[2];
127             } elsif ($sf eq 'Message') {
128 1         2 $val = $msg0;
129             } elsif ($sf eq 'Method') {
130 1   50     4 $val = $per_message_data{caller1}[3] // '';
131             } elsif ($sf eq 'Level') {
132 1         2 $val = $level;
133             } elsif ($sf eq 'PID') {
134 1         3 $val = $$;
135             } elsif ($sf eq 'Elapsed_Start') {
136 1         2 $val = $time_now - $time_start;
137             } elsif ($sf eq 'Elapsed_Last') {
138 1         3 $val = $time_now - $time_last;
139             } elsif ($sf eq 'Stack_Trace') {
140 6         18 $val = join(", ", map { "$_->[3] called at $_->[1] line $_->[2]" }
141 1         3 @{ $per_message_data{callers} });
  1         3  
142 0         0 } else { die "Unknown special field '$f'" }
143 15         47 $msg->{$f} = $val;
144             }
145             }
146 5         16 $pkg->_encode($msg);
147             }
148              
149             sub _get_hooks {
150 5     5   10 my $pkg = shift;
151 5         10 my %plugin_conf = @_;
152              
153             $plugin_conf{packages_to_ignore} //= [
154 5   50     28 "Log::ger",
155             "Log::ger::Layout::LTSV",
156             "Try::Tiny",
157             ];
158              
159             return {
160             create_layouter => [
161             $pkg, # key
162             50, # priority
163             sub { # hook
164 10     10   5957 my %hook_args = @_;
165              
166 10         26 my $layouter = sub { $pkg->_layout(\%plugin_conf, @_) };
  5         4495  
167 10         23 [$layouter];
168 5         29 }],
169             };
170             }
171              
172             sub get_hooks {
173 5     5 0 10475 __PACKAGE__->_get_hooks(@_);
174             }
175              
176             1;
177             # ABSTRACT: Layout log message as LTSV
178              
179             __END__