File Coverage

blib/lib/Zonemaster/Engine/Logger.pm
Criterion Covered Total %
statement 86 95 90.5
branch 19 24 79.1
condition 8 12 66.6
subroutine 15 16 93.7
pod 5 5 100.0
total 133 152 87.5


line stmt bran cond sub pod time code
1             package Zonemaster::Engine::Logger;
2              
3 26     26   94418 use version; our $VERSION = version->declare("v1.0.5");
  26         2567  
  26         184  
4              
5 26     26   2682 use 5.014002;
  26         102  
6 26     26   601 use Moose;
  26         826226  
  26         162  
7              
8 26     26   167784 use Zonemaster::Engine::Logger::Entry;
  26         85  
  26         1125  
9 26     26   214 use Zonemaster::Engine;
  26         59  
  26         616  
10 26     26   8297 use List::MoreUtils qw[none any];
  26         167421  
  26         217  
11 26     26   22187 use Scalar::Util qw[blessed];
  26         92  
  26         1585  
12 26     26   152 use JSON::PP;
  26         54  
  26         18260  
13              
14             has 'entries' => (
15             is => 'ro',
16             isa => 'ArrayRef[Zonemaster::Engine::Logger::Entry]',
17             default => sub { [] }
18             );
19             has 'callback' => ( is => 'rw', isa => 'CodeRef', required => 0, clearer => 'clear_callback' );
20              
21             sub add {
22 89236     89236 1 6447640 my ( $self, $tag, $argref ) = @_;
23              
24 89236         2982217 my $new =
25             Zonemaster::Engine::Logger::Entry->new( { tag => uc( $tag ), args => $argref } );
26 89236         380200 $self->_check_filter( $new );
27 89236         145865 push @{ $self->entries }, $new;
  89236         2539987  
28              
29 89236 100 66     2327500 if ( $self->callback and ref( $self->callback ) eq 'CODE' ) {
30 2443         4161 eval { $self->callback->( $new ) };
  2443         57261  
31 2443 100       8067 if ( $@ ) {
32 5         12 my $err = $@;
33 5 100 66     39 if ( blessed( $err ) and $err->isa( "Zonemaster::Engine::Exception" ) ) {
34 4         23 die $err;
35             }
36             else {
37 1         31 $self->clear_callback;
38 1         8 $self->add( LOGGER_CALLBACK_ERROR => { exception => $err } );
39             }
40             }
41             }
42              
43 89232         227568 return $new;
44             } ## end sub add
45              
46             sub _check_filter {
47 89236     89236   194710 my ( $self, $entry ) = @_;
48 89236         298601 my $config = Zonemaster::Engine->config->logfilter;
49              
50 89236 100       237768 if ( $config ) {
51 3 50       87 if ( $config->{ $entry->module } ) {
52 3         6 my $match = 0;
53 3         4 foreach my $rule ( @{$config->{ $entry->module }{ $entry->tag }} ) {
  3         74  
54 3         5 foreach my $key ( keys %{ $rule->{when} } ) {
  3         9  
55 5         10 my $cond = $rule->{when}{$key};
56 5 100 66     18 if ( ref( $cond ) and ref( $cond ) eq 'ARRAY' ) {
57             ## no critic (TestingAndDebugging::ProhibitNoWarnings)
58             # no warnings 'uninitialized';
59 3 100   5   20 if ( any { $_ eq $entry->args->{$key} } @$cond ) {
  5         125  
60 2         9 $match = 1;
61             } else {
62 1         2 $match = 0;
63 1         2 last;
64             }
65             }
66             else {
67             ## no critic (TestingAndDebugging::ProhibitNoWarnings)
68             # no warnings 'uninitialized';
69 2 50       70 if ( $cond eq $entry->args->{$key} ) {
70 2         7 $match = 1;
71             } else {
72 0         0 $match = 0;
73 0         0 last;
74             }
75             }
76             }
77 3 100       14 if ( $match ) {
78 2         77 $entry->_set_level( $rule->{set} );
79 2         6 last;
80             }
81             }
82             } ## end if ( $config->{ $entry...})
83             } ## end if ( $config )
84             } ## end sub _check_filter
85              
86             sub start_time_now {
87 250     250 1 1188 Zonemaster::Engine::Logger::Entry->start_time_now();
88 250         488 return;
89             }
90              
91             sub clear_history {
92 117     117 1 328 my ( $self ) = @_;
93              
94 117         3325 my $r = $self->entries;
95 117         3589 splice @$r, 0, scalar( @$r );
96              
97 117         3671 return;
98             }
99              
100             # get the max level from a log, return as a string
101             sub get_max_level {
102 0     0 1 0 my ( $self ) = @_;
103              
104 0         0 my %levels = reverse Zonemaster::Engine::Logger::Entry->levels();
105 0         0 my $level = 0;
106              
107 0         0 foreach ( @{ $self->entries } ) {
  0         0  
108 0 0       0 $level = $_->numeric_level if $_->numeric_level > $level;
109             }
110              
111 0         0 return $levels{$level};
112             }
113              
114             sub json {
115 2     2 1 2096 my ( $self, $min_level ) = @_;
116 2         21 my $json = JSON::PP->new->allow_blessed->convert_blessed->canonical;
117 2         217 my %numeric = Zonemaster::Engine::Logger::Entry->levels();
118              
119 2         6 my @msg = @{ $self->entries };
  2         124  
120              
121 2 100 66     14 if ( $min_level and defined $numeric{ uc( $min_level ) } ) {
122 1         5 @msg = grep { $_->numeric_level >= $numeric{ uc( $min_level ) } } @msg;
  9         19  
123             }
124              
125 2         3 my @out;
126 2         8 foreach my $m ( @msg ) {
127 10         13 my %r;
128 10         274 $r{timestamp} = $m->timestamp;
129 10         286 $r{module} = $m->module;
130 10         263 $r{tag} = $m->tag;
131 10         249 $r{level} = $m->level;
132 10 50       241 $r{args} = $m->args if $m->args;
133              
134 10         43 push @out, \%r;
135             }
136              
137 2         10 return $json->encode( \@out );
138             } ## end sub json
139              
140 26     26   208 no Moose;
  26         71  
  26         207  
141             __PACKAGE__->meta->make_immutable;
142              
143             1;
144              
145             =head1 NAME
146              
147             Zonemaster::Engine::Logger - class that holds L<Zonemaster::Engine::Logger::Entry> objects.
148              
149             =head1 SYNOPSIS
150              
151             my $logger = Zonemaster::Engine::Logger->new;
152             $logger->add( TAG => {some => 'arguments'});
153              
154             =head1 ATTRIBUTES
155              
156             =over
157              
158             =item entries
159              
160             A reference to an array holding L<Zonemaster::Engine::Logger::Entry> objects.
161              
162             =item callback($coderef)
163              
164             If this attribute is set, the given code reference will be called every time a
165             log entry is added. The referenced code will be called with the newly created
166             entry as its single argument. The return value of the called code is ignored.
167              
168             If the called code throws an exception, and the exception is not an object of
169             class L<Zonemaster::Engine::Exception> (or a subclass of it), the exception will be
170             logged as a system message at default level C<CRITICAL> and the callback
171             attribute will be cleared.
172              
173             If an exception that is of (sub)class L<Zonemaster::Engine::Exception> is called, the
174             exception will simply be rethrown until it reaches the code that started the
175             test run that logged the message.
176              
177             =back
178              
179             =head1 METHODS
180              
181             =over
182              
183             =item add($tag, $argref)
184              
185             Adds an entry with the given tag and arguments to the logger object.
186              
187             =item json([$level])
188              
189             Returns a JSON-formatted string with all the stored log entries. If an argument
190             is given and is a known severity level, only messages with at least that level
191             will be included.
192              
193             =item get_max_level
194              
195             Returns the maximum log level from the entire log as the level string.
196              
197             =back
198              
199             =head1 CLASS METHOD
200              
201             =over
202              
203             =item start_time_now()
204              
205             Set the logger's start time to the current time.
206              
207             =item clear_history()
208              
209             Remove all known log entries.
210              
211             =back
212              
213             =cut