File Coverage

blib/lib/Dancer2/Logger/LogReport.pm

Criterion	Covered	Total	%
statement	18	18	100.0
branch			n/a
condition			n/a
subroutine	6	6	100.0
pod			n/a
total	24	24	100.0

# This code is part of Perl distribution Dancer2-Plugin-LogReport version 2.02.
# The POD got stripped from this file by OODoc version 3.05.
# For contributors see file ChangeLog.

# This software is copyright (c) 2015-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!

package Dancer2::Logger::LogReport;{
our $VERSION = '2.02';
}

# ABSTRACT: Dancer2 logger engine for Log::Report

use strict;
use warnings;

use Log::Report  'dancer2-plugin-logreport', 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";  # No LR yet

			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;