File Coverage

blib/lib/Eval/Util.pm

Criterion	Covered	Total	%
statement	42	42	100.0
branch	16	16	100.0
condition	10	12	83.3
subroutine	7	7	100.0
pod	4	4	100.0
total	79	81	97.5

package Eval::Util;

our $DATE = '2018-03-12'; # DATE
our $VERSION = '0.002'; # VERSION

use strict;
use warnings;

use Exporter qw(import);
our @EXPORT_OK = qw(
                       inside_eval
                       inside_block_eval
                       inside_string_eval
                       eval_level
               );
# XXX block_eval_level
# XXX string_eval_level

sub inside_eval {
    my $i = 0;
    while (1) {
        my ($package, $filename, $line, $subroutine, $hasargs, $wantarray, $evaltext) = #, $is_require, $hints, $bitmask, $hinthash
            caller($i);
        last unless defined $package;
        $i++;
        if ($subroutine eq "(eval)" || defined $evaltext) {
            return 1;
        }
    };
    0;
}

sub inside_block_eval {
    my $i = 0;
    while (1) {
        my ($package, $filename, $line, $subroutine, $hasargs, $wantarray, $evaltext) = #, $is_require, $hints, $bitmask, $hinthash
            caller($i);
        last unless defined $package;
        $i++;
        if ($subroutine eq "(eval)" && !defined($evaltext)) {
            return 1;
        }
    };
    0;
}

sub inside_string_eval {
    my $i = 0;
    while (1) {
        my ($package, $filename, $line, $subroutine, $hasargs, $wantarray, $evaltext) = #, $is_require, $hints, $bitmask, $hinthash
            caller($i);
        last unless defined $package;
        $i++;
        if ($subroutine eq "(eval)" && defined($evaltext)) {
            return 1;
        }
    };
    0;
}

sub eval_level {
    my $i = 0;
    my $level = 0;
    while (1) {
        my ($package, $filename, $line, $subroutine, $hasargs, $wantarray, $evaltext) = #, $is_require, $hints, $bitmask, $hinthash
            caller($i);
        last unless defined $package;
        $i++;
        if ($subroutine eq "(eval)" || defined $evaltext) {
            $level++;
        }
    };
    $level;
}

1;
# ABSTRACT: Utilities related to eval()

__END__