File Coverage

blib/lib/Log/Sigil.pm

Criterion	Covered	Total	%
statement	38	38	100.0
branch	9	10	90.0
condition			n/a
subroutine	7	7	100.0
pod	2	2	100.0
total	56	57	98.2

package Log::Sigil;
use strict;
use warnings;
use Exporter "import";
use List::Util qw( max );

use constant DEBUG => 0;

our @EXPORT  = qw( swarn swarn2 );
our $VERSION = "1.02";

our @SIGILS    = (
    qw(
        =
        +
        !
        @
    ),
    q{#},
    qw(
        $
        %
        ^
        &
        *
        -
        |
        \
        ~
        ?
    ),
);
our $TIMES     = 3;
our $SEPARATOR = q{ };
our $BIAS      = 0;
our %INDEX     = ( "main::" => 0 ); # Ensure `values` + 1 is the next.
my $ANON_REGEX = qr{ (?: .*::__ANON__ | [(]eval[)] ) \z}msx;

sub swarn {
    my $nth  = 0;
    my $bias = 1;

    $nth++
        while caller $nth;

    my( $package, $filename, $line, $subroutine ) = caller $nth - $bias - $BIAS;

    $bias++;

    $subroutine = "main::"
        if $subroutine eq join q{::}, __PACKAGE__, "swarn";

    $subroutine = "${subroutine}::$line"
        if $subroutine =~ m{$ANON_REGEX};

    $bias++
        if $subroutine =~ m{$ANON_REGEX};

    if ( my @list = caller $nth - $bias - $BIAS ) {
        ( undef, undef, $line ) = @list;
    }

warn "\$package:\t$package"       if DEBUG;
warn "\$filename:\t$filename"     if DEBUG;
warn "\$line:\t$line"             if DEBUG;
warn "\$subroutine:\t$subroutine" if DEBUG;

    unless ( exists $INDEX{ $subroutine } ) {
        $INDEX{ $subroutine } = max( values %INDEX ) + 1;
    }

    my $sigil = $SIGILS[ $INDEX{ $subroutine } % @SIGILS ];
warn "\$sigil:\t$sigil" if DEBUG;
    unshift @_, $sigil x $TIMES, $SEPARATOR;
    push @_, " by ${filename}[$line]: $subroutine\n"; # Ignore if original has \n at the end.

    warn @_;
}

sub swarn2 {
    local $BIAS = $BIAS + 1;
    &swarn;
}

1;
__END__