File Coverage

blib/lib/Log/ger/Output/Perl.pm

Criterion	Covered	Total	%
statement	30	30	100.0
branch	12	14	85.7
condition	1	2	50.0
subroutine	5	5	100.0
pod	0	1	0.0
total	48	52	92.3

package Log::ger::Output::Perl;

our $DATE = '2017-07-24'; # DATE
our $VERSION = '0.001'; # VERSION

use strict;
use warnings;
use Log::ger::Util ();

sub get_hooks {
    my %conf = @_;

    my $action = delete($conf{action}) || {
        warn  => 'warn',
        error => 'warn',
        fatal => 'die',
    };
    keys %conf and die "Unknown configuration: ".join(", ", sort keys %conf);

    return {
        create_logml_routine => [
            __PACKAGE__, 50,
            sub {
                my %args = @_;

                my $logger = sub {
                    my $ctx = shift;
                    my $lvl = shift;
                    if (my $act =
                            $action->{Log::ger::Util::string_level($lvl)}) {
                        if ($act eq 'warn') {
                            warn @_;
                        } elsif ($act eq 'carp') {
                            require Carp;
                            goto &Carp::carp;
                        } elsif ($act eq 'cluck') {
                            require Carp;
                            goto &Carp::cluck;
                        } elsif ($act eq 'croak') {
                            require Carp;
                            goto &Carp::croak;
                        } elsif ($act eq 'confess') {
                            require Carp;
                            goto &Carp::confess;
                        } else {
                            # die is the default action if unknown
                            die @_;
                        }
                    }
                };
                [$logger];
            }],
    };
}

1;
# ABSTRACT: Log to Perl's standard facility (warn, die, etc)

__END__