File Coverage

blib/lib/Dancer2/Logger/Log4perl.pm

Criterion	Covered	Total	%
statement	9	16	56.2
branch	0	4	0.0
condition			n/a
subroutine	3	4	75.0
pod			n/a
total	12	24	50.0

package Dancer2::Logger::Log4perl;
# ABSTRACT: Dancer2 logger interface for Log4perl.

use Log::Log4perl qw( :easy );
use Moo;
use Dancer2::Core::Types;

with 'Dancer2::Core::Role::Logger';

has config_file => (
    is => 'ro',
    isa => ReadableFilePath,
);

has config_watch_interval => (
    is => 'ro',
    isa => sub {
        my $config_watch_interval = shift;

        # Can either be 'HUP' or a number
        Str->( $config_watch_interval );
        if( $config_watch_interval eq 'HUP' ) {
            return;
        }
        else {
            Num->( $config_watch_interval );
        }
    },
);

sub _initialize_log4perl {
    my $self = shift;

    # If config_file is defined, then use that
    if( defined $self->config_file ) {

        # ...optionally with the watch interval
        if( defined $self->config_watch_interval ) {
            Log::Log4perl->init_and_watch( $self->config_file, $self->config_watch_interval );
        }
        else {
            Log::Log4perl->init( $self->config_file );
        }
    }

    # Otherwise we'll easy init with the appropriate log level
    else {
        my $log_level_mapping = {
            'error'   => $ERROR,
            'warn'    => $WARN,
            'warning' => $WARN,
            'info'    => $INFO,
            'debug'   => $DEBUG,
            'trace'   => $TRACE,
            'core'    => $TRACE,
        };

        Log::Log4perl->easy_init( $log_level_mapping->{ $self->log_level } );
    }
}

sub log {
    my ( $self, $level, $message ) = @_;

    # Need to initialize Log4perl if it isn't yet
    if( !Log::Log4perl->initialized() ) {
        $self->_initialize_log4perl();
    }

    # Need to convert Dancer2 log levels to Log4perl levels
    $level = 'warn' if $level eq 'warning';
    $level = 'trace' if $level eq 'core';

    # TODO: Couldn't get $Log::Log4perl::caller_depth to work
    Log::Log4perl->get_logger( scalar caller(4) )->$level( $message );
}

1;

__END__