1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
|
# This code is part of Perl distribution Log-Report version 1.41.
# The POD got stripped from this file by OODoc version 3.04.
# For contributors see file ChangeLog.
# This software is copyright (c) 2007-2025 by Mark Overmeer.
# This is free software; you can redistribute it and/or modify it under
# the same terms as the Perl 5 programming language system itself.
# SPDX-License-Identifier: Artistic-1.0-Perl OR GPL-1.0-or-later
#oodist: *** DO NOT USE THIS VERSION FOR PRODUCTION ***
#oodist: This file contains OODoc-style documentation which will get stripped
#oodist: during its release in the distribution. You can use this file for
#oodist: testing, however the code of this development version may be broken!
#oorestyle: old style disclaimer to be removed.
# This code is part of distribution Log-Report. Meta-POD processed with
# OODoc into POD and HTML manual-pages. See README.md
# Copyright Mark Overmeer. Licensed under the same terms as Perl itself.
package Dancer2::Logger::LogReport;{
our $VERSION = '1.41';
}
# ABSTRACT: Dancer2 logger engine for Log::Report
use strict;
use warnings;
use Log::Report 'log-report', syntax => 'REPORT';
use Moo;
use Dancer2::Core::Types;
use Scalar::Util qw/blessed/;
our $AUTHORITY = 'cpan:MARKOV';
my %level_dancer2lr =
( core => 'TRACE',
debug => 'TRACE'
);
with 'Dancer2::Core::Role::Logger';
# Set by calling function
has dispatchers => (is => 'ro', isa => Maybe[HashRef]);
sub BUILD
{ my $self = shift;
my $configs = $self->dispatchers || +{ default => undef };
$self->{use} = [ keys %$configs ];
dispatcher 'do-not-reopen';
foreach my $name (keys %$configs)
{ my $config = $configs->{$name} || {};
if(keys %$config)
{ my $type = delete $config->{type}
or die "dispatcher configuration $name without type";
dispatcher $type, $name, %$config;
}
}
}
around 'error' => sub {
my ($orig, $self) = (shift, shift);
# If it's a route exception (generated by Dancer) and we're also using the
# Plugin, then the plugin will handle the exception using its own hook into
# the error system. This should be able to removed in the future with
# https://github.com/PerlDancer/Dancer2/pull/1287
return if $_[0] =~ /^Route exception/ && $INC{'Dancer2/Plugin/LogReport.pm'};
$self->log(error => @_);
};
#--------------------
sub log # no protoypes in Dancer2
{ my ($self, $level, $msg) = @_;
my %options;
# If only using the logger on its own (without the associated plugin), make
# it behave like a normal Dancer logger
unless($INC{'Dancer2/Plugin/LogReport.pm'})
{ $msg = $self->format_message($level, $msg);
$options{is_fatal} = 0;
}
# the levels are nearly the same.
my $reason = $level_dancer2lr{$level} || uc $level;
report \%options, $reason => $msg;
undef;
}
1;
|
