Clarify name of guard function from 3d56e026, add it globally

Instead of just marking all my DESTROYs with the function, just add it to a
base class, thus capturing *everything* there is to find. Yes it will be a
tad slower. And yes it will have a massive benefit to any DBIC user happening
to be caught in an unfriendly app-space

diff --git a/lib/DBIx/Class.pm b/lib/DBIx/Class.pm
index 32e4c23..b7f24ee 100644 (file)
--- a/lib/DBIx/Class.pm
+++ b/lib/DBIx/Class.pm
@@ -27,6 +27,13 @@ use DBIx::Class::Exception;
 __PACKAGE__->mk_group_accessors(inherited => '_skip_namespace_frames');
 __PACKAGE__->_skip_namespace_frames('^DBIx::Class|^SQL::Abstract|^Try::Tiny|^Class::Accessor::Grouped|^Context::Preserve');
 
+# FIXME - this is not really necessary, and is in
+# fact going to slow things down a bit
+# However it is the right thing to do in order to get
+# various install bases to highlight their brokenness
+# Remove at some unknown point in the future
+sub DESTROY { &DBIx::Class::_Util::detected_reinvoked_destructor }
+
 sub mk_classdata {
   shift->mk_classaccessor(@_);
 }

diff --git a/lib/DBIx/Class/CDBICompat/DestroyWarning.pm b/lib/DBIx/Class/CDBICompat/DestroyWarning.pm
index 2e29f02..61d243c 100644 (file)
--- a/lib/DBIx/Class/CDBICompat/DestroyWarning.pm
+++ b/lib/DBIx/Class/CDBICompat/DestroyWarning.pm
@@ -3,11 +3,11 @@ package # hide from PAUSE
 
 use strict;
 use warnings;
-use DBIx::Class::_Util 'detect_reinvoked_destructor';
+use DBIx::Class::_Util 'detected_reinvoked_destructor';
 use namespace::clean;
 
 sub DESTROY {
-  return if &detect_reinvoked_destructor;
+  return if &detected_reinvoked_destructor;
 
   my ($self) = @_;
   my $class = ref $self;

diff --git a/lib/DBIx/Class/ResultSource.pm b/lib/DBIx/Class/ResultSource.pm
index 8c8f4cc..4b8f1dd 100644 (file)
--- a/lib/DBIx/Class/ResultSource.pm
+++ b/lib/DBIx/Class/ResultSource.pm
@@ -2306,7 +2306,7 @@ sub handle {
 
 my $global_phase_destroy;
 sub DESTROY {
-  ### NO detect_reinvoked_destructor check
+  ### NO detected_reinvoked_destructor check
   ### This code very much relies on being called multuple times
 
   return if $global_phase_destroy ||= in_global_destruction;

diff --git a/lib/DBIx/Class/Schema.pm b/lib/DBIx/Class/Schema.pm
index 2743203..7b5ae64 100644 (file)
--- a/lib/DBIx/Class/Schema.pm
+++ b/lib/DBIx/Class/Schema.pm
@@ -1385,7 +1385,7 @@ sub _register_source {
 
 my $global_phase_destroy;
 sub DESTROY {
-  ### NO detect_reinvoked_destructor check
+  ### NO detected_reinvoked_destructor check
   ### This code very much relies on being called multuple times
 
   return if $global_phase_destroy ||= in_global_destruction;

diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm
index 26ac850..044ecfa 100644 (file)
--- a/lib/DBIx/Class/Storage/DBI.pm
+++ b/lib/DBIx/Class/Storage/DBI.pm
@@ -13,7 +13,7 @@ use List::Util qw/first/;
 use Context::Preserve 'preserve_context';
 use Try::Tiny;
 use SQL::Abstract qw(is_plain_value is_literal_value);
-use DBIx::Class::_Util qw(quote_sub perlstring serialize detect_reinvoked_destructor);
+use DBIx::Class::_Util qw(quote_sub perlstring serialize detected_reinvoked_destructor);
 use namespace::clean;
 
 # default cursor class, overridable in connect_info attributes
@@ -253,7 +253,7 @@ sub new {
 }
 
 sub DESTROY {
-  return if &detect_reinvoked_destructor;
+  return if &detected_reinvoked_destructor;
 
   $_[0]->_verify_pid unless DBIx::Class::_ENV_::BROKEN_FORK;
   # some databases spew warnings on implicit disconnect

diff --git a/lib/DBIx/Class/Storage/DBI/Cursor.pm b/lib/DBIx/Class/Storage/DBI/Cursor.pm
index 4f591d0..6fdfdf9 100644 (file)
--- a/lib/DBIx/Class/Storage/DBI/Cursor.pm
+++ b/lib/DBIx/Class/Storage/DBI/Cursor.pm
@@ -8,7 +8,7 @@ use base 'DBIx::Class::Cursor';
 use Try::Tiny;
 use Scalar::Util qw(refaddr weaken);
 use List::Util 'shuffle';
-use DBIx::Class::_Util 'detect_reinvoked_destructor';
+use DBIx::Class::_Util 'detected_reinvoked_destructor';
 use namespace::clean;
 
 __PACKAGE__->mk_group_accessors('simple' =>
@@ -234,7 +234,7 @@ sub reset {
 
 
 sub DESTROY {
-  return if &detect_reinvoked_destructor;
+  return if &detected_reinvoked_destructor;
 
   $_[0]->__finish_sth if $_[0]->{sth};
 }

diff --git a/lib/DBIx/Class/Storage/TxnScopeGuard.pm b/lib/DBIx/Class/Storage/TxnScopeGuard.pm
index ed84155..edf7205 100644 (file)
--- a/lib/DBIx/Class/Storage/TxnScopeGuard.pm
+++ b/lib/DBIx/Class/Storage/TxnScopeGuard.pm
@@ -5,7 +5,7 @@ use warnings;
 use Try::Tiny;
 use Scalar::Util qw(weaken blessed refaddr);
 use DBIx::Class;
-use DBIx::Class::_Util qw(is_exception detect_reinvoked_destructor);
+use DBIx::Class::_Util qw(is_exception detected_reinvoked_destructor);
 use DBIx::Class::Carp;
 use namespace::clean;
 
@@ -50,7 +50,7 @@ sub commit {
 }
 
 sub DESTROY {
-  return if &detect_reinvoked_destructor;
+  return if &detected_reinvoked_destructor;
 
   my $self = shift;
 

diff --git a/lib/DBIx/Class/_Util.pm b/lib/DBIx/Class/_Util.pm
index bf8b830..8d25ec0 100644 (file)
--- a/lib/DBIx/Class/_Util.pm
+++ b/lib/DBIx/Class/_Util.pm
@@ -71,7 +71,7 @@ use base 'Exporter';
 our @EXPORT_OK = qw(
   sigwarn_silencer modver_gt_or_eq modver_gt_or_eq_and_lt
   fail_on_internal_wantarray fail_on_internal_call
-  refdesc refcount hrefaddr is_exception detect_reinvoked_destructor
+  refdesc refcount hrefaddr is_exception detected_reinvoked_destructor
   quote_sub qsub perlstring serialize deep_clone
   UNRESOLVABLE_CONDITION
 );
@@ -181,22 +181,21 @@ sub is_exception ($) {
 
   # This is almost invariably invoked from within DESTROY
   # throwing exceptions won't work
-  sub detect_reinvoked_destructor {
+  sub detected_reinvoked_destructor {
 
     # quick "garbage collection" pass - prevents the registry
     # from slowly growing with a bunch of undef-valued keys
     defined $destruction_registry->{$_} or delete $destruction_registry->{$_}
       for keys %$destruction_registry;
 
-    unless (length ref $_[0]) {
-      printf STDERR '%s() expects a reference %s',
+    if (! length ref $_[0]) {
+      printf STDERR '%s() expects a blessed reference %s',
         (caller(0))[3],
         Carp::longmess,
       ;
       return undef; # don't know wtf to do
     }
-
-    if (! defined $destruction_registry->{ my $addr = refaddr($_[0]) } ) {
+    elsif (! defined $destruction_registry->{ my $addr = refaddr($_[0]) } ) {
       weaken( $destruction_registry->{$addr} = $_[0] );
       return 0;
     }

diff --git a/t/lib/DBICTest.pm b/t/lib/DBICTest.pm
index 8bfb572..a3b5f2f 100644 (file)
--- a/t/lib/DBICTest.pm
+++ b/t/lib/DBICTest.pm
@@ -7,6 +7,7 @@ use warnings;
 use DBICTest::Util 'local_umask';
 use DBICTest::Schema;
 use DBICTest::Util::LeakTracer qw/populate_weakregistry assert_empty_weakregistry/;
+use DBIx::Class::_Util 'detected_reinvoked_destructor';
 use Carp;
 use Path::Class::File ();
 use File::Spec;
@@ -217,7 +218,7 @@ sub _database {
           $dbh->{Callbacks} = {
             connect => sub { $guard_cb->('connect') },
             disconnect => sub { $guard_cb->('disconnect') },
-            DESTROY => sub { $guard_cb->('DESTROY') },
+            DESTROY => sub { &detected_reinvoked_destructor; $guard_cb->('DESTROY') },
           };
         }
       },

diff --git a/t/lib/DBICTest/Util.pm b/t/lib/DBICTest/Util.pm
index d4bac7c..985e072 100644 (file)
--- a/t/lib/DBICTest/Util.pm
+++ b/t/lib/DBICTest/Util.pm
@@ -20,6 +20,7 @@ BEGIN {
 use Config;
 use Carp 'confess';
 use Scalar::Util qw(blessed refaddr);
+use DBIx::Class::_Util;
 
 use base 'Exporter';
 our @EXPORT_OK = qw(local_umask stacktrace check_customcond_args visit_namespaces);
@@ -38,6 +39,8 @@ sub local_umask {
 {
   package DBICTest::Util::UmaskGuard;
   sub DESTROY {
+    &DBIx::Class::_Util::detected_reinvoked_destructor;
+
     local ($@, $!);
     eval { defined (umask ${$_[0]}) or die };
     warn ( "Unable to reset old umask ${$_[0]}: " . ($!||'Unknown error') )