File Coverage

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

Criterion	Covered	Total	%
statement	31	31	100.0
branch	4	4	100.0
condition	6	6	100.0
subroutine	10	10	100.0
pod	0	2	0.0
total	51	53	96.2

package Log::ger::Plugin::WithWarn;

our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
our $DATE = '2020-03-11'; # DATE
our $DIST = 'Log-ger-Plugin-WithWarn'; # DIST
our $VERSION = '0.004'; # VERSION

use strict;
use warnings;

use Log::ger ();

sub meta { +{
    v => 2,
} }

sub get_hooks {
    my %plugin_conf = @_;

    return {
        create_routine_names => [
            __PACKAGE__, # key
            50,          # priority
            sub {        # hook
                my %hook_args = @_;

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

                return [{
                    logger_subs => [
                        (map { ["log_${_}_warn", $_, "default"] }
                             grep {$levels->{$_} == 30} keys %$levels),
                    ],
                    level_checker_subs => [],
                    logger_methods => [
                        (map { ["${_}_warn", $_, "default"] }
                             grep {$levels->{$_} == 30} keys %$levels),
                    ],
                    level_checker_methods  => [
                    ],
                }, 0];
            }],
        before_install_routines => [
            __PACKAGE__, # key
            50,          # priority
            sub {        # hook
                my %hook_args = @_;

                # wrap the logger
                for my $r (@{ $hook_args{routines} }) {
                    my ($code, $name, $numlevel, $type) = @$r;
                    if ($type =~ /^log(ger)?_sub/ && $name =~ /\Alog_\w+_warn\z/) {
                        $r->[0] = sub {
                            $code->(@_);
                            warn $hook_args{formatters}{default}(@_)."\n"
                        };
                    } elsif ($type =~ /log(ger)?_method/ && $name =~ /\A\w+_warn\z/) {
                        $r->[0] = sub {
                            $code->(@_);
                            shift;
                            warn $hook_args{formatters}{default}(@_)."\n"
                        };
                    }
                }
            },
        ],
    };
}

1;
# ABSTRACT: Add *_warn logging routines

__END__