File Coverage

blib/lib/Log/Minimal/Indent.pm

Criterion	Covered	Total	%
statement	53	58	91.3
branch	8	14	57.1
condition	2	2	100.0
subroutine	16	18	88.8
pod	4	4	100.0
total	83	96	86.4

package Log::Minimal::Indent;
use 5.010000;
use strict;
use warnings;

our $VERSION = "0.01";

use Log::Minimal;
use Guard;


our $PADDING = "  ";

our @EXPORT_OK = qw/indent_log_guard indent_log_scope/;
our @EXPORT = @EXPORT_OK;

sub import {
    my $class   = shift;
    my $package = caller(0);

    @_ = @EXPORT  unless @_;

    my (@export, @args);
    my $re_export_ok = qr/^(?:@{[ join '|', @EXPORT_OK ]})$/;
    foreach ( @_ ) {
        if ( /$re_export_ok/ ) {
            push @export, $_;
        } else {
            push @args, $_;
        }
    }

    no strict 'refs';
    foreach my $f ( @export ) {
        *{"$package\::$f"} = \&$f;
    }

    @_ = ('Log::Minimal', @args);
    goto &Log::Minimal::import;
}


my $indent_level = 0;

sub forward {
    my ($class, $tag, $level) = @_;
    _level2coderef($level)->("");
    $indent_level++;
}

sub back {
    my ($class, $tag, $level) = @_;
    $indent_level--;
    _level2coderef($level)->("");
}

sub _level2coderef {
    local $_ = uc(shift // '');
    /^DEBUG$/     ? \&Log::Minimal::debugf :
    /^WARN$/      ? \&Log::Minimal::warnf  :
    /^CRITICAL$/  ? \&Log::Minimal::critf  :
    /^MUTE$/      ? \&_empty               :
    /^ERROR$/     ? \&Log::Minimal::croakf : \&Log::Minimal::infof;
}

sub _empty { }


{   # Overwrite Log::Minimal's behaviour
    my $orig_log = \&Log::Minimal::_log;
    no warnings 'redefine';
    *Log::Minimal::_log = sub{
        my $orig_PRINT = $Log::Minimal::PRINT;
        local $Log::Minimal::PRINT = sub{
            $orig_PRINT->(@_, $indent_level);
        };
        $orig_log->(@_);
    };
}

# Modify the default behaviour of PRINT and DIE
$Log::Minimal::PRINT = sub{
    my ( $time, $type, $message, $trace, $raw_message, $indent_level) = @_;
    my $indent = $PADDING x $indent_level;
    warn "$time $indent\[$type] $message at $trace\n";
};

$Log::Minimal::DIE = sub {
    my ( $time, $type, $message, $trace, $raw_message, $indent_level) = @_;
    my $indent = $PADDING x $indent_level;
    die "$time $indent\[$type] $message at $trace\n";
};


sub indent_log_guard {
    my @args = @_;
    __PACKAGE__->forward(@args);
    guard{ __PACKAGE__->back(@args) };
}

sub indent_log_scope {
    my @args = @_;
    __PACKAGE__->forward(@args);
    @_ = sub{ __PACKAGE__->back(@args) };
    goto &scope_guard;
}


1;
__END__