From 638098c9d6fd691493c17e19b5e475354167d6a7 Mon Sep 17 00:00:00 2001
From: Slaven Rezic <
[email protected]>
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
