File Coverage

blib/lib/Log/JSON/Lines.pm
Criterion Covered Total %
statement 72 73 98.6
branch 15 26 57.6
condition 5 6 83.3
subroutine 21 22 95.4
pod 14 14 100.0
total 127 141 90.0


line stmt bran cond sub pod time code
1             package Log::JSON::Lines;
2 2     2   138605 use 5.006; use strict; use warnings; our $VERSION = '1.00';
  2     2   17  
  2     2   11  
  2         4  
  2         42  
  2         9  
  2         3  
  2         120  
3 2     2   1054 use JSON::Lines; use POSIX; use Time::HiRes;
  2     2   66973  
  2     2   22  
  2         1158  
  2         13525  
  2         12  
  2         6808  
  2         2908  
  2         9  
4 2     2   196 use Fcntl qw/ :flock /; use Clone;
  2     2   4  
  2         212  
  2         936  
  2         5243  
  2         1891  
5              
6             sub new {
7 1     1 1 94 my ($class, $file, $level, %jsonl_args) = @_;
8 1 50       14 bless {
9             _file => $file,
10             _jsonl => JSON::Lines->new( %jsonl_args ),
11             _level => defined $level ? $level : 8,
12             _levels => {
13             emerg => 1,
14             alert => 2,
15             crit => 3,
16             err => 4,
17             warning => 5,
18             notice => 6,
19             info => 7,
20             debug => 8,
21             },
22             }, $class;
23             }
24              
25 0     0 1 0 sub file { $_[0]->{_file} }
26              
27 18     18 1 48 sub levels { $_[0]->{_levels} }
28              
29 9     9 1 23 sub level { $_[0]->{_level} }
30              
31             sub jsonl {
32 4     4 1 20 $_[0]->{_jsonl}->clear_stream;
33 4         21 $_[0]->{_jsonl};
34             }
35              
36             sub log {
37 9     9 1 22 my($self, $level, $msg) = @_;
38             die "Invalid level ${level} passed to Log::JSON::Lines->log"
39 9 50       21 unless $self->levels->{$level};
40 9 100       15 return if $self->levels->{$level} > $self->level;
41 4 50       103 $msg = ! ref $msg ? { message => $msg } : Clone::clone($msg);
42 4         14 $msg->{level} = $level;
43 4         16 my ($epoch, $microseconds) = Time::HiRes::gettimeofday;
44 4         246 $msg->{timestamp} = sprintf "%s.%06.0f+00:00",
45             POSIX::strftime("%Y-%m-%dT%H:%M:%S", gmtime($epoch)),
46             $microseconds;
47 4         14 my @caller; my $i = 0; my @stack;
  4         6  
  4         8  
48 4         37 while(@caller = caller($i++)){
49 8 100       37 next if $caller[0] eq 'Log::JSON::Lines';
50 4         14 $stack[$i+1]->{module} = $caller[0];
51 4 50       37 $stack[$i+1]->{file} = $1 if $caller[1] =~ /([^\/]+)$/;;
52 4 50       21 $stack[$i+1]->{line} = $1 if $caller[2] =~ /(\d+)/;
53 4 50       35 $stack[$i]->{sub} = $1 if $caller[3] =~ /([^:]+)$/;
54             }
55             $msg->{stacktrace} = join '->', reverse map {
56 4 50       18 my $module = $_->{module} !~ m/^main$/ ? $_->{module} : $_->{file};
57             $_->{sub}
58             ? $module . '::' . $_->{sub} . ':' . $_->{line}
59             : $module . ':' . $_->{line}
60 4 50       22 } grep {
61 4         9 $_ && $_->{module} && $_->{line} && $_->{file}
62 16 50 100     62 } @stack;
      66        
63 4 50       12 delete $msg->{stacktrace} unless $msg->{stacktrace};
64 4         12 $msg = $self->jsonl->add_line($msg);
65 4 50       430 open my $fh, ">>", $self->{_file} or die "Cannot open log file $self->{_file}: $!";
66 4         43 flock $fh, LOCK_EX;
67 4         42 print $fh $msg;
68 4         111 close $fh;
69 4         36 $msg;
70             }
71              
72             sub emerg {
73 1     1 1 3 my $self = shift;
74 1         4 $self->log('emerg', @_);
75             }
76              
77             sub alert {
78 1     1 1 2 my $self = shift;
79 1         4 $self->log('alert', @_);
80             }
81              
82             sub crit {
83 1     1 1 2 my $self = shift;
84 1         4 $self->log('crit', @_);
85             }
86              
87             sub err {
88 1     1 1 2 my $self = shift;
89 1         5 $self->log('err', @_);
90             }
91              
92             sub warning {
93 1     1 1 2 my $self = shift;
94 1         4 $self->log('warning', @_);
95             }
96              
97             sub notice {
98 1     1 1 2 my $self = shift;
99 1         3 $self->log('notice', @_);
100             }
101              
102             sub info {
103 1     1 1 2 my $self = shift;
104 1         2 $self->log('info', @_);
105             }
106              
107             sub debug {
108 1     1 1 2 my $self = shift;
109 1         2 $self->log('debug', @_);
110             }
111              
112             =head1 NAME
113              
114             Log::JSON::Lines - Log in JSONLines format
115              
116             =head1 VERSION
117              
118             Version 1.00
119              
120             =cut
121              
122             =head1 SYNOPSIS
123              
124             Quick summary of what the module does.
125              
126             use Log::JSON::Lines;
127              
128             my $logger = Log::JSON::Lines->new(
129             '/var/log/definition.log',
130             4,
131             pretty => 1,
132             canonical => 1
133             );
134            
135             $logger->log('info', 'Lets log JSON lines.');
136              
137             $logger->emerg({
138             message => 'emergency',
139             definition => [
140             'a serious, unexpected, and often dangerous situation requiring immediate action.'
141             ]
142             });
143            
144             $logger->alert({
145             message => 'alert',
146             definition => [
147             'quick to notice any unusual and potentially dangerous or difficult circumstances; vigilant.'
148             ]
149             });
150              
151             $logger->crit({
152             message => 'critical',
153             definition => [
154             'expressing adverse or disapproving comments or judgements.'
155             ]
156             });
157              
158             $logger->err({
159             message => 'error',
160             definition => [
161             'the state or condition of being wrong in conduct or judgement.'
162             ]
163             });
164              
165             # the below will not log as the severity level is set to 4 (error)
166              
167             $logger->warning({
168             message => 'warning',
169             definition => [
170             'a statement or event that warns of something or that serves as a cautionary example.'
171             ]
172             });
173              
174             $logger->notice({
175             message => 'notice',
176             definition => [
177             'the fact of observing or paying attention to something.'
178             ]
179             });
180              
181             $logger->info({
182             message => 'information',
183             definition => [
184             'what is conveyed or represented by a particular arrangement or sequence of things.'
185             ]
186             });
187              
188             $logger->debug({
189             message => 'debug',
190             definition => [
191             'identify and remove errors from (computer hardware or software).'
192             ]
193             });
194              
195             =head1 DESCRIPTION
196              
197             This module is a simple logger that encodes data in JSON Lines format.
198              
199             JSON Lines is a convenient format for storing structured data that may be processed one record at a time. It works well with unix-style text processing tools and shell pipelines. It's a great format for log files. It's also a flexible format for passing messages between cooperating processes.
200              
201             L
202              
203             =head1 SUBROUTINES/METHODS
204              
205             =head2 new
206              
207             Instantiate a new Log::JSON::Lines object. This expects a filename and optionally a level which value is between 0 to 8 and params that will be passed through to instantiate the JSON::Lines object.
208              
209             my $logger = Log::JSON::Lines->new($filename, $severity_level, %JSON::Lines::params);
210              
211             =head2 file
212              
213             Returns the current log file name.
214              
215             $logger->file();
216              
217             =head2 levels
218              
219             Returns the severity level mapping.
220              
221             $logger->levels();
222              
223             =head2 level
224              
225             Returns the current severity level.
226              
227             $logger->level();
228              
229             =head2 jsonl
230              
231             Returns the JSON::Lines object used to encode the line.
232              
233             $logger->jsonl();
234              
235             =head2 log
236              
237             Log a message to the specified log file. This expects a severity level to be passed and either a string message or hashref containing information that you would like to log.
238              
239             $logger->log($severity, $message);
240              
241             =head2 emerg - 1
242              
243             Log a emerg line to the specified log file. This expects either a string or hashref containing information that you would like to log.
244              
245             $logger->emerg($message);
246              
247             =head2 alert - 2
248              
249             Log a alert line to the specified log file. This expects either a string or hashref containing information that you would like to log.
250              
251             $logger->alert($message);
252              
253             =head2 crit - 3
254              
255             Log a critical line to the specified log file. This expects either a string or hashref containing information that you would like to log.
256              
257             $logger->crit($message);
258              
259             =head2 err - 4
260              
261             Log a error line to the specified log file. This expects either a string or hashref containing information that you would like to log.
262              
263             $logger->err($message);
264              
265             =head2 warning - 5
266              
267             Log a warning line to the specified log file. This expects either a string or hashref containing information that you would like to log.
268              
269             $logger->warning($message);
270              
271             =head2 notice - 6
272              
273             Log a notice line to the specified log file. This expects either a string or hashref containing information that you would like to log.
274              
275             $logger->notice($message);
276              
277             =head2 info - 7
278              
279             Log a info line to the specified log file. This expects either a string or hashref containing information that you would like to log.
280              
281             $logger->info($message);
282              
283             =head2 debug - 8
284              
285             Log a debug line to the specified log file. This expects either a string or hashref containing information that you would like to log.
286              
287             $logger->debug($message);
288              
289             =head1 AUTHOR
290              
291             LNATION, C<< >>
292              
293             =head1 BUGS
294              
295             Please report any bugs or feature requests to C, or through
296             the web interface at L. I will be notified, and then you'll
297             automatically be notified of progress on your bug as I make changes.
298              
299             =head1 SUPPORT
300              
301             You can find documentation for this module with the perldoc command.
302              
303             perldoc Log::JSON::Lines
304              
305             You can also look for information at:
306              
307             =over 4
308              
309             =item * RT: CPAN's request tracker (report bugs here)
310              
311             L
312              
313             =item * CPAN Ratings
314              
315             L
316              
317             =item * Search CPAN
318              
319             L
320              
321             =back
322              
323             =head1 ACKNOWLEDGEMENTS
324              
325             =head1 LICENSE AND COPYRIGHT
326              
327             This software is Copyright (c) 2020->2021 by LNATION.
328              
329             This is free software, licensed under:
330              
331             The Artistic License 2.0 (GPL Compatible)
332              
333             =cut
334              
335             1; # End of Log::JSON::Lines