From 638098c9d6fd691493c17e19b5e475354167d6a7 Mon Sep 17 00:00:00 2001 From: Slaven Rezic <slaven@rezic.de> Date: Sat, 20 Jan 2018 14:58:49 +0100 Subject: [PATCH] use warnings::enabled_at_level etc. for perl >= 5.27.8 (RT #123811) --- lib/DBM/Deep.pm | 26 ++++++++++++++++++-------- 1 file changed, 18 insertions(+), 8 deletions(-) diff --git a/lib/DBM/Deep.pm b/lib/DBM/Deep.pm index 762c162..994a516 100644 --- a/lib/DBM/Deep.pm +++ b/lib/DBM/Deep.pm @@ -636,21 +636,31 @@ sub clear { (shift)->CLEAR( @_ ) } sub _dump_file {shift->_get_self->_engine->_dump_file;} sub _warnif { - # There is, unfortunately, no way to avoid this hack. warnings.pm does not - # allow us to specify exactly the call frame we want. So, for now, we just - # look at the bitmask ourselves. my $level; { my($pack, $file, $line, $bitmask) = (caller $level++)[0..2,9]; redo if $pack =~ /^DBM::Deep(?:::|\z)/; - if( vec $bitmask, $warnings'Offsets{$_[0]}, 1, - || vec $bitmask, $warnings'Offsets{all}, 1, - ) { + if(defined &warnings::enabled_at_level) { # perl >= 5.27.8 + if(warnings::enabled_at_level($_[0], $level-1)) { my $msg = $_[1] =~ /\n\z/ ? $_[1] : "$_[1] at $file line $line.\n"; die $msg - if vec $bitmask, $warnings'Offsets{$_[0]}+1, 1, - || vec $bitmask, $warnings'Offsets{all}+1, 1; + if warnings::fatal_enabled_at_level($_[0], $level-1); warn $msg; + } + } else { + # In older perl versions (< 5.27.8) there is, unfortunately, no way + # to avoid this hack. warnings.pm did not allow us to specify + # exactly the call frame we want, so we have to look at the bitmask + # ourselves. + if( vec $bitmask, $warnings'Offsets{$_[0]}, 1, + || vec $bitmask, $warnings'Offsets{all}, 1, + ) { + my $msg = $_[1] =~ /\n\z/ ? $_[1] : "$_[1] at $file line $line.\n"; + die $msg + if vec $bitmask, $warnings'Offsets{$_[0]}+1, 1, + || vec $bitmask, $warnings'Offsets{all}+1, 1; + warn $msg; + } } } } -- 2.1.4