From: Peter Rabbitson Date: Tue, 17 Mar 2015 11:29:18 +0000 (+0100) Subject: Clarify name of guard function from 3d56e026, add it globally X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=e1d9e578b84f642cb24181d0403b15ab78a9fda7;p=dbsrgits%2FDBIx-Class-Historic.git 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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') )