File Coverage

blib/lib/Log/ger/Plugin/WithCarp.pm

Criterion	Covered	Total	%
statement	58	58	100.0
branch	18	20	90.0
condition	24	24	100.0
subroutine	15	15	100.0
pod	0	1	0.0
total	115	118	97.4

package Log::ger::Plugin::WithCarp;

our $DATE = '2017-08-04'; # DATE
our $VERSION = '0.002'; # VERSION

use strict;
use warnings;

use Carp ();
use Log::ger ();

sub get_hooks {
    my %conf = @_;

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

                my $levels = \%Log::ger::Levels;

                return [{
                    log_subs    => [
                        (map { (["log_${_}_carp", $_, "default"], ["log_${_}_cluck", $_, "default"]) }
                             grep {$levels->{$_} == 30} keys %$levels),
                        (map { (["log_${_}_croak", $_, "default"], ["log_${_}_confess", $_, "default"]) }
                             grep {$levels->{$_} > 0 && $levels->{$_} <= 20} keys %$levels),
                    ],
                    is_subs     => [],
                    log_methods => [
                        (map { (["${_}_carp", $_, "default"], ["${_}_cluck", $_, "default"]) }
                             grep {$levels->{$_} == 30} keys %$levels),
                        (map { (["${_}_croak", $_, "default"], ["${_}_confess", $_, "default"]) }
                             grep {$levels->{$_} > 0 && $levels->{$_} <= 20} keys %$levels),
                    ],
                    logml_methods => [
                    ],
                    is_methods  => [
                    ],
                }, 0];
            }],
        before_install_routines => [
            __PACKAGE__, 50,
            sub {
                my %args = @_;

                # wrap the logger
                for my $r (@{ $args{routines} }) {
                    my ($code, $name, $numlevel, $type) = @$r;
                    if    ($type eq 'log_sub'    && $name =~ /\Alog_\w+_carp\z/   ) { $r->[0] = sub { $code->(@_);        Carp::carp   ($args{formatters}{default}(@_)."\n") } }
                    elsif ($type eq 'log_method' && $name =~ /\A\w+_carp\z/       ) { $r->[0] = sub { $code->(@_); shift; Carp::carp   ($args{formatters}{default}(@_)."\n") } }
                    elsif ($type eq 'log_sub'    && $name =~ /\Alog_\w+_cluck\z/  ) { $r->[0] = sub { $code->(@_);        Carp::cluck  ($args{formatters}{default}(@_)."\n") } }
                    elsif ($type eq 'log_method' && $name =~ /\A\w+_cluck\z/      ) { $r->[0] = sub { $code->(@_); shift; Carp::cluck  ($args{formatters}{default}(@_)."\n") } }
                    elsif ($type eq 'log_sub'    && $name =~ /\Alog_\w+_croak\z/  ) { $r->[0] = sub { $code->(@_);        Carp::croak  ($args{formatters}{default}(@_)."\n") } }
                    elsif ($type eq 'log_method' && $name =~ /\A\w+_croak\z/      ) { $r->[0] = sub { $code->(@_); shift; Carp::croak  ($args{formatters}{default}(@_)."\n") } }
                    elsif ($type eq 'log_sub'    && $name =~ /\Alog_\w+_confess\z/) { $r->[0] = sub { $code->(@_);        Carp::confess($args{formatters}{default}(@_)."\n") } }
                    elsif ($type eq 'log_method' && $name =~ /\A\w+_confess\z/    ) { $r->[0] = sub { $code->(@_); shift; Carp::confess($args{formatters}{default}(@_)."\n") } }
                }
            },
        ],
    };
}

1;
# ABSTRACT: Add *_{carp,cluck,croak,confess} logging routines

__END__