File Coverage

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

Criterion	Covered	Total	%
statement	30	38	78.9
branch	4	10	40.0
condition	2	4	50.0
subroutine	9	9	100.0
pod	0	2	0.0
total	45	63	71.4

package Log::ger::Plugin::MultilevelLog;

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

use strict;
use warnings;

use Log::ger::Util;

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

sub get_hooks {
    my %conf = @_;

    my $sub_name    = $conf{sub_name}    || 'log';
    my $method_name = $conf{method_name} || 'log';

    return {
        create_filter => [
            __PACKAGE__, # key
            50,          # priority
            sub {        # hook
                my %hook_args = @_; # see Log::ger::Manual::Internals/"Arguments passed to hook"

                my $filter = sub {
                    my $level = Log::ger::Util::numeric_level(shift);
                    return 0 unless $level <= $Log::ger::Current_Level;
                    {level=>$level};
                };

                [$filter, 0, 'ml'];
            },
        ],

        create_formatter => [
            __PACKAGE__, # key
            50,          # priority
            sub {        # hook
                my %hook_args = @_; # see Log::ger::Manual::Internals/"Arguments passed to hook"

                my $formatter =

                 # just like the default formatter, except it accepts first
                 # argument (level)
                    sub {
                        shift; # level
                        return $_[0] if @_ < 2;
                        my $fmt = shift;
                        my @args;
                        for (@_) {
                            if (!defined($_)) {
                                push @args, '';
                            } elsif (ref $_) {
                                push @args, Log::ger::Util::_dump($_);
                            } else {
                                push @args, $_;
                            }
                        }
                        # redefine is just a dummy category for perls < 5.22
                        # which don't have 'redundant' yet
                        no warnings ($warnings::Bits{'redundant'} ? 'redundant' : 'redefine');
                        sprintf $fmt, @args;
                    };

                [$formatter, 0, 'ml'];
            },
        ],

        create_routine_names => [
            __PACKAGE__, # key
            50,          # priority
            sub {        # hook
                my %hook_args = @_; # see Log::ger::Manual::Internals/"Arguments passed to hook"
                return [{
                    logger_subs    => [[$sub_name   , undef, 'ml', undef, 'ml']],
                    logger_methods => [[$method_name, undef, 'ml', undef, 'ml']],
                }, $conf{exclusive}];
            },
        ],
    };
}

1;
# ABSTRACT: Create a log($LEVEL, ...) subroutine/method

__END__