File Coverage

blib/lib/Log/Any/Adapter/JSON.pm
Criterion Covered Total %
statement 91 98 92.8
branch 24 32 75.0
condition 8 16 50.0
subroutine 16 16 100.0
pod 0 3 0.0
total 139 165 84.2


line stmt bran cond sub pod time code
1             package Log::Any::Adapter::JSON;
2              
3             our $VERSION = '1.14';
4              
5 10     10   1634903 use strict;
  10         73  
  10         285  
6 10     10   49 use warnings;
  10         17  
  10         313  
7 10     10   45 use feature 'say';
  10         16  
  10         1293  
8              
9 10     10   76 use Carp qw/ croak confess /;
  10         19  
  10         643  
10 10     10   52 use Cpanel::JSON::XS;
  10         15  
  10         663  
11 10     10   987 use Path::Tiny;
  10         12271  
  10         547  
12 10     10   5172 use Time::Moment;
  10         14651  
  10         459  
13 10     10   5205 use strictures 2;
  10         15172  
  10         383  
14              
15 10     10   2852 use Log::Any::Adapter::Util 'make_method';
  10         15957  
  10         545  
16              
17 10     10   614 use parent 'Log::Any::Adapter::Base';
  10         444  
  10         90  
18              
19             my $trace_level = Log::Any::Adapter::Util::numeric_level('trace');
20              
21             sub new {
22 9     9 0 793 my ($class, $filename_or_handle, %args) = @_;
23              
24 9         18 my $handle;
25 9         24 my $ref = ref($filename_or_handle);
26              
27 9 50 33     107 if ( $ref && $ref ne 'GLOB' ) {
    50          
28 0         0 croak('Died: Not a filehandle');
29             }
30             elsif ($ref) {
31 9         32 $handle = $filename_or_handle;
32             }
33             else {
34 0         0 $handle = path($filename_or_handle)->opena;
35             }
36              
37 9         127 $handle->autoflush;
38              
39 9   50     746 my $encoding = delete($args{encoding}) || 'UTF-8';
40 9     9   248 binmode $handle, ":encoding($encoding)";
  9         61  
  9         15  
  9         72  
41              
42 9         10751 $args{handle} = $handle;
43 9   33     65 $args{log_level} //= $trace_level;
44              
45 9         114 return $class->SUPER::new(%args);
46             }
47              
48             sub structured {
49 24     24 0 619 my $self = shift;
50 24         75 my ($level, $category, $string, @items) = @_;
51              
52 24 50       93 return if Log::Any::Adapter::Util::numeric_level($level) > $self->{log_level};
53              
54 24         315 my $log_entry = _prepare_log_entry($self, @_);
55              
56 15         63 select $self->{handle};
57 15         776 say $log_entry;
58 15         109 select STDOUT;
59             }
60              
61             sub _prepare_log_entry {
62 24     24   75 my ($self, $level, $category, $string, @items) = @_;
63              
64 24 100       89 confess 'Died: A log message is required' if ! $string;
65              
66 22 100       68 my $method = $self->{localtime} ? 'now' : 'now_utc';
67              
68 22         255 my $time = Time::Moment->$method;
69 22         147 my $float = $time->strftime('%f');
70 22   50     79 $float ||= '.';
71 22         72 $float .= 0 while length $float < 7;
72              
73 22         243 my %log_entry = (
74             time => join('', $time->strftime('%FT%T'), $float, $time->strftime('%Z')),
75             level => $level,
76             category => $category,
77             );
78              
79             # Process pattern and values if present, unless not wanted
80 22 100 100     203 if ( ! $self->{without_formatting} && (my $num_tokens =()= $string =~ m/%s|%d/g) ) {
81 8         21 my @vals = grep { ! ref } splice @items, 0, $num_tokens;
  16         31  
82              
83 8 100       18 if ( @vals < $num_tokens ) {
84 2 50       5 my $inflected = $num_tokens == 1 ? 'value is' : 'values are';
85 2         28 confess sprintf('Died: %s scalar %s required for this pattern', $num_tokens, $inflected);
86             }
87              
88 6         34 $log_entry{message} = sprintf($string, @vals);
89             }
90             else {
91 14         41 $log_entry{message} = $string;
92             }
93              
94             # Process structured data and additional messages if present.
95             # The first hashref encountered has its keys promoted to top-level.
96 19         30 my $seen_href;
97              
98 19         47 for my $item ( @items ) {
99              
100 18 100       52 if ( ref($item) eq 'HASH' ) {
    100          
101             # special handling for Log::Any's context hash
102 10 100       30 if ( $item->{context} ) {
103 2         6 $log_entry{context} = delete $item->{context};
104             }
105              
106 10 100       26 if ( ! $seen_href ) {
107 8         17 for my $key ( keys %{ $item } ) {
  8         25  
108 8 100       38 if ( $key =~ /^(?:time|level|category|message)$/ ) {
109 4         64 confess sprintf(
110             'Died: %s is a reserved key name and may not be passed in the first hashref',
111             $key,
112             );
113             }
114              
115 4         12 $log_entry{$key} = $item->{$key};
116             }
117 4         10 $seen_href++;
118             }
119             else {
120 2         4 push @{ $log_entry{hash_data} }, $item;
  2         7  
121             }
122             }
123             elsif ( ref($item) eq 'ARRAY' ) {
124 2         3 push @{ $log_entry{list_data} }, $item;
  2         4  
125             }
126             else {
127 6         8 push ( @{ $log_entry{additional_messages} }, $item);
  6         14  
128             }
129             }
130              
131 15         171 my $serializer = Cpanel::JSON::XS->new
132             ->utf8(0)
133             ->pretty(0)
134             ->indent(0)
135             ->canonical(1)
136             ->allow_stringify(1);
137              
138 15         284 return $serializer->encode( \%log_entry );
139             }
140              
141             #-- Methods required by the base class --------------------------------#
142              
143             sub init {
144 9     9 0 95 my $self = shift;
145 9 50 33     92 if ( $self->{log_level} && $self->{log_level} =~ /\D/ ) {
146 0         0 my $numeric_level = Log::Any::Adapter::Util::numeric_level( $self->{log_level} );
147              
148 0 0       0 if ( ! defined($numeric_level) ) {
149 0         0 croak sprintf('Invalid log level [%s]', $self->{log_level});
150             }
151              
152 0         0 $self->{log_level} = $numeric_level;
153             }
154              
155 9 50       41 if ( ! defined $self->{log_level} ) {
156 0         0 $self->{log_level} = $trace_level;
157             }
158             }
159              
160             for my $method ( Log::Any->detection_methods ) {
161             my $base = substr($method, 3);
162             my $method_level = Log::Any::Adapter::Util::numeric_level( $base );
163              
164             make_method( $method, sub {
165 24     24   65366 return !!( $method_level <= $_[0]->{log_level} );
166             });
167             }
168              
169              
170              
171             1; # return true
172              
173             __END__