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   114607 use version; our $VERSION = version->declare("v1.0.5");
  26         2580  
  26         210  
4              
5 26     26   2969 use 5.014002;
  26         107  
6 26     26   651 use Moose;
  26         507311  
  26         163  
7              
8 26     26   173852 use Zonemaster::Engine::Logger::Entry;
  26         92  
  26         1064  
9 26     26   195 use Zonemaster::Engine;
  26         48  
  26         541  
10 26     26   8281 use List::MoreUtils qw[none any];
  26         171633  
  26         214  
11 26     26   22282 use Scalar::Util qw[blessed];
  26         66  
  26         1560  
12 26     26   153 use JSON::PP;
  26         57  
  26         17697  
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 6408125 my ( $self, $tag, $argref ) = @_;
23              
24 89236         3006718 my $new =
25             Zonemaster::Engine::Logger::Entry->new( { tag => uc( $tag ), args => $argref } );
26 89236         400326 $self->_check_filter( $new );
27 89236         133887 push @{ $self->entries }, $new;
  89236         2527260  
28              
29 89236 100 66     2303787 if ( $self->callback and ref( $self->callback ) eq 'CODE' ) {
30 2443         4487 eval { $self->callback->( $new ) };
  2443         62069  
31 2443 100       7851 if ( $@ ) {
32 5         11 my $err = $@;
33 5 100 66     43 if ( blessed( $err ) and $err->isa( "Zonemaster::Engine::Exception" ) ) {
34 4         23 die $err;
35             }
36             else {
37 1         54 $self->clear_callback;
38 1         11 $self->add( LOGGER_CALLBACK_ERROR => { exception => $err } );
39             }
40             }
41             }
42              
43 89232         232963 return $new;
44             } ## end sub add
45              
46             sub _check_filter {
47 89236     89236   208286 my ( $self, $entry ) = @_;
48 89236         317221 my $config = Zonemaster::Engine->config->logfilter;
49              
50 89236 100       233075 if ( $config ) {
51 3 50       124 if ( $config->{ $entry->module } ) {
52 3         6 my $match = 0;
53 3         4 foreach my $rule ( @{$config->{ $entry->module }{ $entry->tag }} ) {
  3         81  
54 3         5 foreach my $key ( keys %{ $rule->{when} } ) {
  3         11  
55 5         10 my $cond = $rule->{when}{$key};
56 5 100 66     20 if ( ref( $cond ) and ref( $cond ) eq 'ARRAY' ) {
57             ## no critic (TestingAndDebugging::ProhibitNoWarnings)
58             # no warnings 'uninitialized';
59 3 100   5   21 if ( any { $_ eq $entry->args->{$key} } @$cond ) {
  5         178  
60 2         10 $match = 1;
61             } else {
62 1         3 $match = 0;
63 1         3 last;
64             }
65             }
66             else {
67             ## no critic (TestingAndDebugging::ProhibitNoWarnings)
68             # no warnings 'uninitialized';
69 2 50       50 if ( $cond eq $entry->args->{$key} ) {
70 2         5 $match = 1;
71             } else {
72 0         0 $match = 0;
73 0         0 last;
74             }
75             }
76             }
77 3 100       12 if ( $match ) {
78 2         60 $entry->_set_level( $rule->{set} );
79 2         5 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 1132 Zonemaster::Engine::Logger::Entry->start_time_now();
88 250         497 return;
89             }
90              
91             sub clear_history {
92 117     117 1 311 my ( $self ) = @_;
93              
94 117         3397 my $r = $self->entries;
95 117         3593 splice @$r, 0, scalar( @$r );
96              
97 117         3787 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 2112 my ( $self, $min_level ) = @_;
116 2         17 my $json = JSON::PP->new->allow_blessed->convert_blessed->canonical;
117 2         177 my %numeric = Zonemaster::Engine::Logger::Entry->levels();
118              
119 2         9 my @msg = @{ $self->entries };
  2         118  
120              
121 2 100 66     15 if ( $min_level and defined $numeric{ uc( $min_level ) } ) {
122 1         4 @msg = grep { $_->numeric_level >= $numeric{ uc( $min_level ) } } @msg;
  9         27  
123             }
124              
125 2         5 my @out;
126 2         4 foreach my $m ( @msg ) {
127 10         18 my %r;
128 10         281 $r{timestamp} = $m->timestamp;
129 10         278 $r{module} = $m->module;
130 10         270 $r{tag} = $m->tag;
131 10         246 $r{level} = $m->level;
132 10 50       256 $r{args} = $m->args if $m->args;
133              
134 10         41 push @out, \%r;
135             }
136              
137 2         16 return $json->encode( \@out );
138             } ## end sub json
139              
140 26     26   191 no Moose;
  26         56  
  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