File Coverage

blib/lib/Devel/CompileLevel.pm

Criterion	Covered	Total	%
statement	31	31	100.0
branch	7	8	87.5
condition			n/a
subroutine	8	8	100.0
pod	2	2	100.0
total	48	49	97.9

package Devel::CompileLevel;
use strict;
use warnings;
no warnings 'once';

our $VERSION = '0.001002';
$VERSION =~ tr/_//d;

use Exporter (); BEGIN { *import = \&Exporter::import }

our @EXPORT_OK = qw(
  compile_level
  compile_caller
);

sub compile_level () {
  no warnings;
  local ${^WARNING_BITS} = $warnings::NONE;
  my $level = 0;
  while (my @caller = caller(++$level)) {
    my $hints = $caller[9];
    next
      if $hints ne ${^WARNING_BITS};
    ${^WARNING_BITS} ^= "\x01";
    my $newhints = (caller($level))[9];
    if ($newhints ne $hints) {
      return $level - 1;
    }
  }
  return undef;
}

sub compile_caller () {
  my $level = compile_level;
  return
    unless defined $level;

  if (caller eq 'DB') {
    package
      DB;
    caller($level - 1);
  }
  else {
    caller($level - 1);
  }
}

1;

__END__