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.16';
4              
5 10     10   1793556 use strict;
  10         72  
  10         324  
6 10     10   61 use warnings;
  10         23  
  10         275  
7 10     10   58 use feature 'say';
  10         17  
  10         1508  
8              
9 10     10   69 use Carp qw/ croak confess /;
  10         27  
  10         629  
10 10     10   74 use Cpanel::JSON::XS;
  10         20  
  10         637  
11 10     10   967 use Path::Tiny;
  10         12157  
  10         508  
12 10     10   5064 use Time::Moment;
  10         15910  
  10         399  
13 10     10   5504 use strictures 2;
  10         17590  
  10         405  
14              
15 10     10   3049 use Log::Any::Adapter::Util 'make_method';
  10         9231  
  10         547  
16              
17 10     10   576 use parent 'Log::Any::Adapter::Base';
  10         334  
  10         100  
18              
19             my $trace_level = Log::Any::Adapter::Util::numeric_level('trace');
20              
21             sub new {
22 9     9 0 832 my ($class, $filename_or_handle, %args) = @_;
23              
24 9         19 my $handle;
25 9         27 my $ref = ref($filename_or_handle);
26              
27 9 50 33     109 if ( $ref && $ref ne 'GLOB' ) {
    50          
28 0         0 croak('Died: Not a filehandle');
29             }
30             elsif ($ref) {
31 9         18 $handle = $filename_or_handle;
32             }
33             else {
34 0         0 $handle = path($filename_or_handle)->opena;
35             }
36              
37 9         126 $handle->autoflush;
38              
39 9   50     827 my $encoding = delete($args{encoding}) || 'UTF-8';
40 9     9   290 binmode $handle, ":encoding($encoding)";
  9         64  
  9         21  
  9         112  
41              
42 9         11383 $args{handle} = $handle;
43 9   33     69 $args{log_level} //= $trace_level;
44              
45 9         98 return $class->SUPER::new(%args);
46             }
47              
48             sub structured {
49 24     24 0 684 my $self = shift;
50 24         80 my ($level, $category, $string, @items) = @_;
51              
52 24 50       88 return if Log::Any::Adapter::Util::numeric_level($level) > $self->{log_level};
53              
54 24         332 my $log_entry = _prepare_log_entry($self, @_);
55              
56 15         79 select $self->{handle};
57 15         945 say $log_entry;
58 15         125 select STDOUT;
59             }
60              
61             sub _prepare_log_entry {
62 24     24   81 my ($self, $level, $category, $string, @items) = @_;
63              
64 24 100       88 confess 'Died: A log message is required' if ! $string;
65              
66 22 100       70 my $method = $self->{localtime} ? 'now' : 'now_utc';
67              
68 22         272 my $time = Time::Moment->$method;
69 22         151 my $float = $time->strftime('%f');
70 22   50     64 $float ||= '.';
71 22         76 $float .= 0 while length $float < 7;
72              
73 22         331 my %log_entry = (
74             timestamp => 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     241 if ( ! $self->{without_formatting} && (my $num_tokens =()= $string =~ m/%s|%d/g) ) {
81 8         23 my @vals = grep { ! ref } splice @items, 0, $num_tokens;
  16         41  
82              
83 8 100       22 if ( @vals < $num_tokens ) {
84 2 50       7 my $inflected = $num_tokens == 1 ? 'value is' : 'values are';
85 2         35 confess sprintf('Died: %s scalar %s required for this pattern', $num_tokens, $inflected);
86             }
87              
88 6         43 $log_entry{message} = sprintf($string, @vals);
89             }
90             else {
91 14         44 $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         33 my $seen_href;
97              
98 19         48 for my $item ( @items ) {
99              
100 18 100       60 if ( ref($item) eq 'HASH' ) {
    100          
101             # special handling for Log::Any's context hash
102 10 100       32 if ( $item->{context} ) {
103 2         6 $log_entry{context} = delete $item->{context};
104             }
105              
106 10 100       28 if ( ! $seen_href ) {
107 8         15 for my $key ( keys %{ $item } ) {
  8         29  
108 8 100       44 if ( $key =~ /^(?:time|level|category|message)$/ ) {
109 4         85 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         13 $log_entry{$key} = $item->{$key};
116             }
117 4         13 $seen_href++;
118             }
119             else {
120 2         5 push @{ $log_entry{hash_data} }, $item;
  2         9  
121             }
122             }
123             elsif ( ref($item) eq 'ARRAY' ) {
124 2         3 push @{ $log_entry{list_data} }, $item;
  2         6  
125             }
126             else {
127 6         10 push ( @{ $log_entry{additional_messages} }, $item);
  6         19  
128             }
129             }
130              
131 15         191 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         323 return $serializer->encode( \%log_entry );
139             }
140              
141             #-- Methods required by the base class --------------------------------#
142              
143             sub init {
144 9     9 0 91 my $self = shift;
145 9 50 33     94 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       40 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   74300 return !!( $method_level <= $_[0]->{log_level} );
166             });
167             }
168              
169              
170              
171             1; # return true
172              
173             __END__