From: Peter Rabbitson <ribasushi@cpan.org>
Date: Wed, 3 Feb 2016 00:32:00 +0000 (+0100)
Subject: Protect DBIC as best we can from the failure mode in 7cb35852
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ddcc02d14d03169c54c65db9f0f446836483ba55;p=dbsrgits%2FDBIx-Class.git

Protect DBIC as best we can from the failure mode in 7cb35852

The main idea is that while exception_action works just like $SIG{__DIE__},
this is less than ideal as non-sufficiently-careful software can completely
abort a callstack by goto()-ing out of it (not to mention the annoyance of
users when receiving callbacks on exceptions that DBIC later handles).

So this changeset makes exception_action() behave *better* than $SIG{__DIE__}
by meticlously annotating every DBIC-internal recoverable-exception site and
ensuring that exception_action (and any $SIG{__DIE__} callback) is not
invoked in this case ( see the diff of t/61findnot.t specifically )

This is a rather heavy and involved set of changes, but there seems to be no
other way to go around this. There were complaints already due to firing o
handlers on recoverable errors, but this is the first time the integrity of
the actul DBIC code flow was broken. Thus an executive decision was made to
solve this for good (took about 2 full days of work, sigh...)

The main part of this changset is in ::Schema.pm and ::_Util.pm, the rest is
simply switching from try/eval =>  dbic_internal_try. Some codepaths can not
be executed due to lack of RDBMS, but afaict it all works.

The changes were audited by a combination of:

  watch -x grep -rnP --exclude='*.pod' '^(?!\s*\#).*?(\beval\b|\btry\b)' lib

  git diff HEAD^ \
  |  perl -0777 -e 'my $str = <>; while( $str =~ /(?:\A|^index)(.+?)(?:^diff|\z)/gsm) { my $substr = $1; warn $substr if ( $substr =~ /dbic_internal_try/ and $substr !~ /DBIx::Class::_Util/ ) }' 2>&1 \
  | less

And a BaseSchema.pm exception_action hook which registers failures on any
invocation which is not paired with an eval/thows_ok/etc in a t/**.t frame.
In other words we make sure when exception_action is invoked - a test is there
waiting for the resulting exception, assuming any other exception is transient
( needs DBICTEST_ASSERT_NO_SPURIOUS_EXCEPTION_ACTION to be set ).

Additionally there is a global CI-enabled Try::Tiny::try override which fails
on calls from within the DBIx::Class namespace.
---

diff --git a/Changes b/Changes
index 87395b8..5396723 100644
--- a/Changes
+++ b/Changes
@@ -1,6 +1,11 @@
 Revision history for DBIx::Class
 
     * Notable Changes and Deprecations
+        - Neither exception_action() nor $SIG{__DIE__} handlers are invoked
+          on recoverable errors. This ensures that the retry logic is fully
+          insulated from changes in control flow, as the handlers are only
+          invoked when an error is leaving the DBIC internals to be handled by
+          the caller (n.b. https://github.com/PerlDancer/Dancer2/issues/1125)
         - $result->related_resultset() no longer passes extra arguments to
           an underlying search_rs(), as by design these arguments would be
           used only on the first call to ->related_resultset(), and ignored
diff --git a/lib/DBIx/Class/Carp.pm b/lib/DBIx/Class/Carp.pm
index 49c75fb..fbd37e5 100644
--- a/lib/DBIx/Class/Carp.pm
+++ b/lib/DBIx/Class/Carp.pm
@@ -35,7 +35,7 @@ sub __find_caller {
 # Need a way to parameterize this for Carp::Skip
       $1 !~ /^(?: DBIx::Class::Storage::BlockRunner | Context::Preserve | Try::Tiny | Class::Accessor::Grouped | Class::C3::Componentised | Module::Runtime | Sub::Uplevel )$/x
         and
-      $2 !~ /^(?: throw_exception | carp | carp_unique | carp_once | dbh_do | txn_do | with_deferred_fk_checks | __delicate_rollback )$/x
+      $2 !~ /^(?: throw_exception | carp | carp_unique | carp_once | dbh_do | txn_do | with_deferred_fk_checks | __delicate_rollback | dbic_internal_try )$/x
 #############################
     ) ? $f[3] : undef;
 
diff --git a/lib/DBIx/Class/InflateColumn/DateTime.pm b/lib/DBIx/Class/InflateColumn/DateTime.pm
index 7abf5ac..8ccdf7a 100644
--- a/lib/DBIx/Class/InflateColumn/DateTime.pm
+++ b/lib/DBIx/Class/InflateColumn/DateTime.pm
@@ -4,6 +4,7 @@ use strict;
 use warnings;
 use base qw/DBIx::Class/;
 use DBIx::Class::Carp;
+use DBIx::Class::_Util 'dbic_internal_try';
 use Try::Tiny;
 use namespace::clean;
 
@@ -197,7 +198,7 @@ sub _flate_or_fallback
   my $preferred_method = sprintf($method_fmt, $info->{ _ic_dt_method });
   my $method = $parser->can($preferred_method) || sprintf($method_fmt, 'datetime');
 
-  return try {
+  return dbic_internal_try {
     $parser->$method($value);
   }
   catch {
diff --git a/lib/DBIx/Class/Relationship/BelongsTo.pm b/lib/DBIx/Class/Relationship/BelongsTo.pm
index a538f44..a3e7dbc 100644
--- a/lib/DBIx/Class/Relationship/BelongsTo.pm
+++ b/lib/DBIx/Class/Relationship/BelongsTo.pm
@@ -7,6 +7,7 @@ package # hide from PAUSE
 use strict;
 use warnings;
 use Try::Tiny;
+use DBIx::Class::_Util 'dbic_internal_try';
 use namespace::clean;
 
 our %_pod_inherit_config =
@@ -41,7 +42,7 @@ sub belongs_to {
     )  unless $class->has_column($f_key);
 
     $class->ensure_class_loaded($f_class);
-    my $f_rsrc = try {
+    my $f_rsrc = dbic_internal_try {
       $f_class->result_source_instance;
     }
     catch {
diff --git a/lib/DBIx/Class/Relationship/CascadeActions.pm b/lib/DBIx/Class/Relationship/CascadeActions.pm
index bcd3800..59aefc1 100644
--- a/lib/DBIx/Class/Relationship/CascadeActions.pm
+++ b/lib/DBIx/Class/Relationship/CascadeActions.pm
@@ -4,6 +4,7 @@ package # hide from PAUSE
 use strict;
 use warnings;
 use DBIx::Class::Carp;
+use DBIx::Class::_Util 'dbic_internal_try';
 use namespace::clean;
 
 our %_pod_inherit_config =
@@ -28,7 +29,7 @@ sub delete {
     my $ret = $self->next::method(@rest);
 
     foreach my $rel (@cascade) {
-      if( my $rel_rs = eval{ $self->search_related($rel) } ) {
+      if( my $rel_rs = dbic_internal_try { $self->search_related($rel) } ) {
         $rel_rs->delete_all;
       } else {
         carp "Skipping cascade delete on relationship '$rel' - related resultsource '$rels{$rel}{class}' is not registered with this schema";
diff --git a/lib/DBIx/Class/Relationship/HasMany.pm b/lib/DBIx/Class/Relationship/HasMany.pm
index eecda46..053eda6 100644
--- a/lib/DBIx/Class/Relationship/HasMany.pm
+++ b/lib/DBIx/Class/Relationship/HasMany.pm
@@ -3,7 +3,7 @@ package # hide from PAUSE
 
 use strict;
 use warnings;
-use Try::Tiny;
+use DBIx::Class::_Util 'dbic_internal_try';
 use namespace::clean;
 
 our %_pod_inherit_config =
@@ -30,7 +30,7 @@ sub has_many {
 
 # FIXME - this check needs to be moved to schema-composition time...
 #    # only perform checks if the far side appears already loaded
-#    if (my $f_rsrc = try { $f_class->result_source_instance } ) {
+#    if (my $f_rsrc = dbic_internal_try { $f_class->result_source_instance } ) {
 #      $class->throw_exception(
 #        "No such column '$f_key' on foreign class ${f_class} ($guess)"
 #      ) if !$f_rsrc->has_column($f_key);
diff --git a/lib/DBIx/Class/Relationship/HasOne.pm b/lib/DBIx/Class/Relationship/HasOne.pm
index 94981dc..3141259 100644
--- a/lib/DBIx/Class/Relationship/HasOne.pm
+++ b/lib/DBIx/Class/Relationship/HasOne.pm
@@ -5,6 +5,7 @@ use strict;
 use warnings;
 use DBIx::Class::Carp;
 use Try::Tiny;
+use DBIx::Class::_Util 'dbic_internal_try';
 use namespace::clean;
 
 our %_pod_inherit_config =
@@ -34,7 +35,7 @@ sub _has_one {
       # at this point we need to load the foreigner, expensive or not
       $class->ensure_class_loaded($f_class);
 
-      $f_rsrc = try {
+      $f_rsrc = dbic_internal_try {
         my $r = $f_class->result_source_instance;
         die "There got to be some columns by now... (exception caught and rewritten by catch below)"
           unless $r->columns;
@@ -60,7 +61,7 @@ sub _has_one {
 # FIXME - this check needs to be moved to schema-composition time...
 #    # only perform checks if the far side was not preloaded above *AND*
 #    # appears to have been loaded by something else (has a rsrc_instance)
-#    if (! $f_rsrc and $f_rsrc = try { $f_class->result_source_instance }) {
+#    if (! $f_rsrc and $f_rsrc = dbic_internal_try { $f_class->result_source_instance }) {
 #      $class->throw_exception(
 #        "No such column '$f_key' on foreign class ${f_class} ($guess)"
 #      ) if !$f_rsrc->has_column($f_key);
diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm
index be4a69e..0a6c002 100644
--- a/lib/DBIx/Class/ResultSet.pm
+++ b/lib/DBIx/Class/ResultSet.pm
@@ -8,6 +8,7 @@ use DBIx::Class::ResultSetColumn;
 use DBIx::Class::ResultClass::HashRefInflator;
 use Scalar::Util qw/blessed weaken reftype/;
 use DBIx::Class::_Util qw(
+  dbic_internal_try
   fail_on_internal_wantarray fail_on_internal_call UNRESOLVABLE_CONDITION
 );
 use Try::Tiny;
@@ -878,7 +879,7 @@ sub find {
         join "\x00", sort $rsrc->unique_constraint_columns($c_name)
       }++;
 
-      try {
+      dbic_internal_try {
         push @unique_queries, $self->_qualify_cond_columns(
           $self->result_source->_minimal_valueset_satisfying_constraint(
             constraint_name => $c_name,
diff --git a/lib/DBIx/Class/ResultSource.pm b/lib/DBIx/Class/ResultSource.pm
index 204d3be..03231c7 100644
--- a/lib/DBIx/Class/ResultSource.pm
+++ b/lib/DBIx/Class/ResultSource.pm
@@ -9,10 +9,9 @@ use DBIx::Class::ResultSet;
 use DBIx::Class::ResultSourceHandle;
 
 use DBIx::Class::Carp;
-use DBIx::Class::_Util 'UNRESOLVABLE_CONDITION';
+use DBIx::Class::_Util qw( UNRESOLVABLE_CONDITION dbic_internal_try );
 use SQL::Abstract 'is_literal_value';
 use Devel::GlobalDestruction;
-use Try::Tiny;
 use Scalar::Util qw/blessed weaken isweak/;
 
 use namespace::clean;
@@ -403,12 +402,12 @@ sub column_info {
   if ( ! $self->_columns->{$column}{data_type}
        and ! $self->{_columns_info_loaded}
        and $self->column_info_from_storage
-       and my $stor = try { $self->storage } )
+       and my $stor = dbic_internal_try { $self->storage } )
   {
     $self->{_columns_info_loaded}++;
 
     # try for the case of storage without table
-    try {
+    dbic_internal_try {
       my $info = $stor->columns_info_for( $self->from );
       my $lc_info = { map
         { (lc $_) => $info->{$_} }
@@ -481,12 +480,12 @@ sub columns_info {
       and
     grep { ! $_->{data_type} } values %$colinfo
       and
-    my $stor = try { $self->storage }
+    my $stor = dbic_internal_try { $self->storage }
   ) {
     $self->{_columns_info_loaded}++;
 
     # try for the case of storage without table
-    try {
+    dbic_internal_try {
       my $info = $stor->columns_info_for( $self->from );
       my $lc_info = { map
         { (lc $_) => $info->{$_} }
@@ -1130,7 +1129,7 @@ sub resultset {
   $self->resultset_class->new(
     $self,
     {
-      try { %{$self->schema->default_resultset_attributes} },
+      ( dbic_internal_try { %{$self->schema->default_resultset_attributes} } ),
       %{$self->{resultset_attributes}},
     },
   );
@@ -1471,7 +1470,7 @@ sub reverse_relationship_info {
     # to use the source_names, otherwise we will use the actual classes
 
     # the schema may be partial
-    my $roundtrip_rsrc = try { $other_rsrc->related_source($other_rel) }
+    my $roundtrip_rsrc = dbic_internal_try { $other_rsrc->related_source($other_rel) }
       or next;
 
     if ($registered_source_name) {
@@ -2269,7 +2268,7 @@ sub related_source {
   # if we are not registered with a schema - just use the prototype
   # however if we do have a schema - ask for the source by name (and
   # throw in the process if all fails)
-  if (my $schema = try { $self->schema }) {
+  if (my $schema = dbic_internal_try { $self->schema }) {
     $schema->source($self->relationship_info($rel)->{source});
   }
   else {
diff --git a/lib/DBIx/Class/ResultSourceHandle.pm b/lib/DBIx/Class/ResultSourceHandle.pm
index 05be07d..b9b54bf 100644
--- a/lib/DBIx/Class/ResultSourceHandle.pm
+++ b/lib/DBIx/Class/ResultSourceHandle.pm
@@ -5,7 +5,7 @@ use warnings;
 
 use base qw/DBIx::Class/;
 
-use Try::Tiny;
+use DBIx::Class::_Util 'dbic_internal_try';
 use namespace::clean;
 
 use overload
@@ -112,7 +112,7 @@ sub STORABLE_thaw {
   }
   elsif( my $rs = $from_class->result_source_instance ) {
     # in the off-chance we are using CDBI-compat and have leaked $schema already
-    if( my $s = try { $rs->schema } ) {
+    if( my $s = dbic_internal_try { $rs->schema } ) {
       $self->schema( $s );
     }
     else {
diff --git a/lib/DBIx/Class/Row.pm b/lib/DBIx/Class/Row.pm
index 77628ad..daf5885 100644
--- a/lib/DBIx/Class/Row.pm
+++ b/lib/DBIx/Class/Row.pm
@@ -7,7 +7,7 @@ use base qw/DBIx::Class/;
 
 use Scalar::Util 'blessed';
 use List::Util 'first';
-use Try::Tiny;
+use DBIx::Class::_Util 'dbic_internal_try';
 use DBIx::Class::Carp;
 use SQL::Abstract qw( is_literal_value is_plain_value );
 
@@ -621,7 +621,7 @@ sub delete {
     $self->in_storage(0);
   }
   else {
-    my $rsrc = try { $self->result_source_instance }
+    my $rsrc = dbic_internal_try { $self->result_source_instance }
       or $self->throw_exception("Can't do class delete without a ResultSource instance");
 
     my $attrs = @_ > 1 && ref $_[$#_] eq 'HASH' ? { %{pop(@_)} } : {};
@@ -900,7 +900,7 @@ sub _is_column_numeric {
     if (
       ! defined $colinfo->{is_numeric}
         and
-      my $storage = try { $self->result_source->schema->storage }
+      my $storage = dbic_internal_try { $self->result_source->schema->storage }
     ) {
       $colinfo->{is_numeric} =
         $storage->is_datatype_numeric ($colinfo->{data_type})
@@ -1580,7 +1580,11 @@ See L<DBIx::Class::Schema/throw_exception>.
 sub throw_exception {
   my $self=shift;
 
-  if (ref $self && ref (my $rsrc = try { $self->result_source_instance } ) ) {
+  if (
+    ref $self
+      and
+    my $rsrc = dbic_internal_try { $self->result_source_instance }
+  ) {
     $rsrc->throw_exception(@_)
   }
   else {
diff --git a/lib/DBIx/Class/Schema.pm b/lib/DBIx/Class/Schema.pm
index f6777d4..5f03739 100644
--- a/lib/DBIx/Class/Schema.pm
+++ b/lib/DBIx/Class/Schema.pm
@@ -8,7 +8,10 @@ use base 'DBIx::Class';
 use DBIx::Class::Carp;
 use Try::Tiny;
 use Scalar::Util qw/weaken blessed/;
-use DBIx::Class::_Util qw(refcount quote_sub is_exception scope_guard);
+use DBIx::Class::_Util qw(
+  refcount quote_sub scope_guard
+  is_exception dbic_internal_try
+);
 use Devel::GlobalDestruction;
 use namespace::clean;
 
@@ -191,7 +194,7 @@ sub _ns_get_rsrc_instance {
   my $me = shift;
   my $rs_class = ref ($_[0]) || $_[0];
 
-  return try {
+  return dbic_internal_try {
     $rs_class->result_source_instance
   } catch {
     $me->throw_exception (
@@ -803,7 +806,7 @@ sub connection {
 
   $storage_class =~ s/^::/DBIx::Class::Storage::/;
 
-  try {
+  dbic_internal_try {
     $self->ensure_class_loaded ($storage_class);
   }
   catch {
@@ -1057,7 +1060,11 @@ default behavior will provide a detailed stack trace.
 sub throw_exception {
   my ($self, @args) = @_;
 
-  if (my $act = $self->exception_action) {
+  if (
+    ! DBIx::Class::_Util::in_internal_try()
+      and
+    my $act = $self->exception_action
+  ) {
 
     my $guard_disarmed;
 
@@ -1401,7 +1408,7 @@ sub _register_source {
   return $source if $params->{extra};
 
   my $rs_class = $source->result_class;
-  if ($rs_class and my $rsrc = try { $rs_class->result_source_instance } ) {
+  if ($rs_class and my $rsrc = dbic_internal_try { $rs_class->result_source_instance } ) {
     my %map = %{$self->class_mappings};
     if (
       exists $map{$rs_class}
@@ -1511,7 +1518,7 @@ sub compose_connection {
   carp_once "compose_connection deprecated as of 0.08000"
     unless $INC{"DBIx/Class/CDBICompat.pm"};
 
-  try {
+  dbic_internal_try {
     require DBIx::Class::ResultSetProxy;
   }
   catch {
diff --git a/lib/DBIx/Class/Schema/Versioned.pm b/lib/DBIx/Class/Schema/Versioned.pm
index ba3b445..d59961f 100644
--- a/lib/DBIx/Class/Schema/Versioned.pm
+++ b/lib/DBIx/Class/Schema/Versioned.pm
@@ -202,8 +202,8 @@ use warnings;
 use base 'DBIx::Class::Schema';
 
 use DBIx::Class::Carp;
+use DBIx::Class::_Util 'dbic_internal_try';
 use Time::HiRes qw/gettimeofday/;
-use Try::Tiny;
 use Scalar::Util 'weaken';
 use namespace::clean;
 
@@ -527,7 +527,7 @@ sub get_db_version
     my ($self, $rs) = @_;
 
     my $vtable = $self->{vschema}->resultset('Table');
-    my $version = try {
+    my $version = dbic_internal_try {
       $vtable->search({}, { order_by => { -desc => 'installed' }, rows => 1 } )
               ->get_column ('version')
                ->next;
@@ -746,14 +746,15 @@ sub _read_sql_file {
 
 sub _source_exists
 {
-    my ($self, $rs) = @_;
-
-    return try {
-      $rs->search(\'1=0')->cursor->next;
-      1;
-    } catch {
-      0;
-    };
+  my ($self, $rs) = @_;
+
+  ( dbic_internal_try {
+    $rs->search(\'1=0')->cursor->next;
+    1;
+  } )
+    ? 1
+    : 0
+  ;
 }
 
 =head1 FURTHER QUESTIONS?
diff --git a/lib/DBIx/Class/Storage.pm b/lib/DBIx/Class/Storage.pm
index fc87ceb..47aef36 100644
--- a/lib/DBIx/Class/Storage.pm
+++ b/lib/DBIx/Class/Storage.pm
@@ -16,6 +16,7 @@ use DBIx::Class::Carp;
 use DBIx::Class::Storage::BlockRunner;
 use Scalar::Util qw/blessed weaken/;
 use DBIx::Class::Storage::TxnScopeGuard;
+use DBIx::Class::_Util 'dbic_internal_try';
 use Try::Tiny;
 use namespace::clean;
 
@@ -253,12 +254,12 @@ sub txn_rollback {
     $self->{transaction_depth}--;
 
     # in case things get really hairy - just disconnect
-    eval { $self->_exec_txn_rollback; 1 } or do {
+    dbic_internal_try { $self->_exec_txn_rollback; 1 } or do {
       my $rollback_error = $@;
 
       # whatever happens, too low down the stack to care
       # FIXME - revisit if stackable exceptions become a thing
-      eval { $self->disconnect };
+      dbic_internal_try { $self->disconnect };
 
       die $rollback_error;
     };
@@ -310,16 +311,19 @@ sub __delicate_rollback {
     return;
   }
 
+  my @args = @_;
   my $rbe;
 
-  local $@; # taking no chances
-  unless( eval { $self->txn_rollback; 1 } ) {
+  dbic_internal_try {
+    $self->txn_rollback; 1
+  }
+  catch {
 
-    $rbe = $@;
+    $rbe = $_;
 
     # we were passed an existing exception to augment (think DESTROY stacks etc)
-    if (@_) {
-      my $exception = shift;
+    if (@args) {
+      my ($exception) = @args;
 
       # append our text - THIS IS A TEMPORARY FIXUP!
       #
@@ -367,7 +371,7 @@ sub __delicate_rollback {
         ) =~ s/Transaction aborted: (?=Transaction aborted:)//;
       }
     }
-  }
+  };
 
   return $rbe;
 }
@@ -577,7 +581,7 @@ sub debugobj {
           $self->throw_exception("Unable to parse TRACE_PROFILE config file '$profile' without $missing");
         }
 
-        my $cfg = try {
+        my $cfg = dbic_internal_try {
           Config::Any->load_files({ files => [$profile], use_ext => 1 });
         } catch {
           # sanitize the error message a bit
@@ -603,7 +607,7 @@ sub debugobj {
       #
       # Yes I am aware this is fragile and TxnScopeGuard needs
       # a better fix. This is another yak to shave... :(
-      try {
+      dbic_internal_try {
         DBIx::Class::Storage::Debug::PrettyPrint->new(@pp_args);
       } catch {
         $self->throw_exception($_);
diff --git a/lib/DBIx/Class/Storage/BlockRunner.pm b/lib/DBIx/Class/Storage/BlockRunner.pm
index 0a8dded..0f884da 100644
--- a/lib/DBIx/Class/Storage/BlockRunner.pm
+++ b/lib/DBIx/Class/Storage/BlockRunner.pm
@@ -7,7 +7,7 @@ use strict;
 use DBIx::Class::Exception;
 use DBIx::Class::Carp;
 use Context::Preserve 'preserve_context';
-use DBIx::Class::_Util qw(is_exception qsub);
+use DBIx::Class::_Util qw( is_exception qsub dbic_internal_try );
 use Scalar::Util qw(weaken blessed reftype);
 use Try::Tiny;
 use Moo;
@@ -122,7 +122,7 @@ sub _run {
   my $run_err = '';
 
   return preserve_context {
-    try {
+    dbic_internal_try {
       if (defined $txn_init_depth) {
         $self->storage->txn_begin;
         $txn_begin_ok = 1;
@@ -156,7 +156,13 @@ sub _run {
         ) unless $delta_txn == 1 and $cur_depth == 0;
       }
       else {
-        $run_err = eval { $storage->txn_commit; 1 } ? '' : $@;
+        dbic_internal_try {
+          $storage->txn_commit;
+          1;
+        }
+        catch {
+          $run_err = $_;
+        };
       }
     }
 
diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm
index 7c7c5c2..ac6489d 100644
--- a/lib/DBIx/Class/Storage/DBI.pm
+++ b/lib/DBIx/Class/Storage/DBI.pm
@@ -13,7 +13,11 @@ 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 detected_reinvoked_destructor scope_guard);
+use DBIx::Class::_Util qw(
+  quote_sub perlstring serialize
+  dbic_internal_try
+  detected_reinvoked_destructor scope_guard
+);
 use namespace::clean;
 
 # default cursor class, overridable in connect_info attributes
@@ -1146,7 +1150,7 @@ sub _server_info {
 
     my $info = {};
 
-    my $server_version = try {
+    my $server_version = dbic_internal_try {
       $self->_get_server_version
     } catch {
       # driver determination *may* use this codepath
@@ -1207,7 +1211,7 @@ sub _describe_connection {
   my $self = shift;
 
   my $drv;
-  try {
+  dbic_internal_try {
     $drv = $self->_extract_driver_from_connect_info;
     $self->ensure_connected;
   };
@@ -1221,7 +1225,7 @@ sub _describe_connection {
     DBIC_DRIVER => ref $self,
     $drv ? (
       DBD => $drv,
-      DBD_VER => try { $drv->VERSION },
+      DBD_VER => dbic_internal_try { $drv->VERSION },
     ) : (),
   };
 
@@ -1262,7 +1266,7 @@ sub _describe_connection {
   ) {
     # some drivers barf on things they do not know about instead
     # of returning undef
-    my $v = try { $self->_dbh_get_info($inf) };
+    my $v = dbic_internal_try { $self->_dbh_get_info($inf) };
     next unless defined $v;
 
     #my $key = sprintf( '%s(%s)', $inf, $DBI::Const::GetInfoType::GetInfoType{$inf} );
@@ -1404,7 +1408,7 @@ sub _warn_undetermined_driver {
 sub _do_connection_actions {
   my ($self, $method_prefix, $call, @args) = @_;
 
-  try {
+  dbic_internal_try {
     if (not ref($call)) {
       my $method = $method_prefix . $call;
       $self->$method(@args);
@@ -1528,7 +1532,7 @@ sub _connect {
     }, '__DBIC__DBH__ERROR__HANDLER__';
   };
 
-  try {
+  dbic_internal_try {
     if(ref $info->[0] eq 'CODE') {
       $dbh = $info->[0]->();
     }
@@ -1998,7 +2002,7 @@ sub insert {
   if (my $retlist = $sqla_opts->{returning}) {  # if IR is supported - we will get everything in one set
 
     unless( @ir_container ) {
-      try {
+      dbic_internal_try {
 
         # FIXME - need to investigate why Caelum silenced this in 4d4dc518
         local $SIG{__WARN__} = sub {};
@@ -2343,7 +2347,7 @@ sub _dbh_execute_for_fetch {
 
   my $tuple_status = [];
   my ($rv, $err);
-  try {
+  dbic_internal_try {
     $rv = $sth->execute_for_fetch(
       $fetch_tuple,
       $tuple_status,
@@ -2362,7 +2366,7 @@ sub _dbh_execute_for_fetch {
   );
 
   # Statement must finish even if there was an exception.
-  try {
+  dbic_internal_try {
     $sth->finish
   }
   catch {
@@ -2390,7 +2394,7 @@ sub _dbh_execute_inserts_with_no_binds {
   my ($self, $sth, $count) = @_;
 
   my $err;
-  try {
+  dbic_internal_try {
     my $dbh = $self->_get_dbh;
     local $dbh->{RaiseError} = 1;
     local $dbh->{PrintError} = 0;
@@ -2402,7 +2406,7 @@ sub _dbh_execute_inserts_with_no_binds {
   };
 
   # Make sure statement is finished even if there was an exception.
-  try {
+  dbic_internal_try {
     $sth->finish
   }
   catch {
@@ -2501,7 +2505,7 @@ sub _select_args {
       and
     @{$attrs->{group_by}}
       and
-    my $grp_aliases = try { # try{} because $attrs->{from} may be unreadable
+    my $grp_aliases = dbic_internal_try { # internal_try{} because $attrs->{from} may be unreadable
       $self->_resolve_aliastypes_from_select_args({ from => $attrs->{from}, group_by => $attrs->{group_by} })
     }
   ) {
@@ -2618,7 +2622,7 @@ sub _dbh_columns_info_for {
   my %result;
 
   if (! DBIx::Class::_ENV_::STRESSTEST_COLUMN_INFO_UNAWARE_STORAGE and $dbh->can('column_info')) {
-    try {
+    dbic_internal_try {
       my ($schema,$tab) = $table =~ /^(.+?)\.(.+)$/ ? ($1,$2) : (undef,$table);
       my $sth = $dbh->column_info( undef,$schema, $tab, '%' );
       $sth->execute();
@@ -2722,7 +2726,7 @@ Return the row id of the last insert.
 sub _dbh_last_insert_id {
     my ($self, $dbh, $source, $col) = @_;
 
-    my $id = try { $dbh->last_insert_id (undef, undef, $source->name, $col) };
+    my $id = dbic_internal_try { $dbh->last_insert_id (undef, undef, $source->name, $col) };
 
     return $id if defined $id;
 
@@ -2773,15 +2777,15 @@ sub _determine_supports_placeholders {
 
   # some drivers provide a $dbh attribute (e.g. Sybase and $dbh->{syb_dynamic_supported})
   # but it is inaccurate more often than not
-  return try {
+  ( dbic_internal_try {
     local $dbh->{PrintError} = 0;
     local $dbh->{RaiseError} = 1;
     $dbh->do('select ?', {}, 1);
     1;
-  }
-  catch {
-    0;
-  };
+  } )
+    ? 1
+    : 0
+  ;
 }
 
 # Check if placeholders bound to non-string types throw exceptions
@@ -2790,16 +2794,16 @@ sub _determine_supports_typeless_placeholders {
   my $self = shift;
   my $dbh  = $self->_get_dbh;
 
-  return try {
+  ( dbic_internal_try {
     local $dbh->{PrintError} = 0;
     local $dbh->{RaiseError} = 1;
     # this specifically tests a bind that is NOT a string
     $dbh->do('select 1 where 1 = ?', {}, 1);
     1;
-  }
-  catch {
-    0;
-  };
+  } )
+    ? 1
+    : 0
+  ;
 }
 
 =head2 sqlt_type
@@ -3135,7 +3139,7 @@ sub deploy {
     return if($line =~ /^COMMIT/m);
     return if $line =~ /^\s+$/; # skip whitespace only
     $self->_query_start($line);
-    try {
+    dbic_internal_try {
       # do a dbh_do cycle here, as we need some error checking in
       # place (even though we will ignore errors)
       $self->dbh_do (sub { $_[1]->do($line) });
diff --git a/lib/DBIx/Class/Storage/DBI/Cursor.pm b/lib/DBIx/Class/Storage/DBI/Cursor.pm
index 6fdfdf9..d900431 100644
--- a/lib/DBIx/Class/Storage/DBI/Cursor.pm
+++ b/lib/DBIx/Class/Storage/DBI/Cursor.pm
@@ -5,10 +5,9 @@ use warnings;
 
 use base 'DBIx::Class::Cursor';
 
-use Try::Tiny;
 use Scalar::Util qw(refaddr weaken);
 use List::Util 'shuffle';
-use DBIx::Class::_Util 'detected_reinvoked_destructor';
+use DBIx::Class::_Util qw( detected_reinvoked_destructor dbic_internal_try );
 use namespace::clean;
 
 __PACKAGE__->mk_group_accessors('simple' =>
@@ -251,8 +250,17 @@ sub __finish_sth {
   my $self = shift;
 
   # No need to care about failures here
-  try { local $SIG{__WARN__} = sub {}; $self->{sth}->finish } if (
-    $self->{sth} and ! try { ! $self->{sth}->FETCH('Active') }
+  dbic_internal_try {
+    local $SIG{__WARN__} = sub {};
+    $self->{sth}->finish
+  } if (
+    $self->{sth}
+      and
+    # weird double-negative to catch the case of ->FETCH throwing
+    # and attempt a finish *anyway*
+    ! dbic_internal_try {
+      ! $self->{sth}->FETCH('Active')
+    }
   );
 }
 
diff --git a/lib/DBIx/Class/Storage/DBI/InterBase.pm b/lib/DBIx/Class/Storage/DBI/InterBase.pm
index 0793a0f..7b6ef6c 100644
--- a/lib/DBIx/Class/Storage/DBI/InterBase.pm
+++ b/lib/DBIx/Class/Storage/DBI/InterBase.pm
@@ -4,7 +4,7 @@ use strict;
 use warnings;
 use base qw/DBIx::Class::Storage::DBI::Firebird::Common/;
 use mro 'c3';
-use Try::Tiny;
+use DBIx::Class::_Util 'dbic_internal_try';
 use namespace::clean;
 
 =head1 NAME
@@ -38,12 +38,13 @@ sub _ping {
   local $dbh->{RaiseError} = 1;
   local $dbh->{PrintError} = 0;
 
-  return try {
+  (dbic_internal_try {
     $dbh->do('select 1 from rdb$database');
     1;
-  } catch {
-    0;
-  };
+  })
+    ? 1
+    : 0
+  ;
 }
 
 # We want dialect 3 for new features and quoting to work, DBD::InterBase uses
diff --git a/lib/DBIx/Class/Storage/DBI/MSSQL.pm b/lib/DBIx/Class/Storage/DBI/MSSQL.pm
index 5b4c422..4eb090a 100644
--- a/lib/DBIx/Class/Storage/DBI/MSSQL.pm
+++ b/lib/DBIx/Class/Storage/DBI/MSSQL.pm
@@ -9,7 +9,7 @@ use base qw/
 /;
 use mro 'c3';
 
-use Try::Tiny;
+use DBIx::Class::_Util 'dbic_internal_try';
 use List::Util 'first';
 use namespace::clean;
 
@@ -81,7 +81,7 @@ sub _execute {
 
     # we didn't even try on ftds
     unless ($self->_no_scope_identity_query) {
-      ($identity) = try { $sth->fetchrow_array };
+      ($identity) = dbic_internal_try { $sth->fetchrow_array };
       $sth->finish;
     }
 
@@ -161,7 +161,7 @@ sub sql_limit_dialect {
     # stored procedures like xp_msver, or version detection failed for some
     # other reason.
     # So, we use a query to check if RNO is implemented.
-    try {
+    dbic_internal_try {
       $self->_get_dbh->selectrow_array('SELECT row_number() OVER (ORDER BY rand())');
       $supports_rno = 1;
     };
@@ -178,12 +178,13 @@ sub _ping {
   local $dbh->{RaiseError} = 1;
   local $dbh->{PrintError} = 0;
 
-  return try {
+  (dbic_internal_try {
     $dbh->do('select 1');
     1;
-  } catch {
-    0;
-  };
+  })
+    ? 1
+    : 0
+  ;
 }
 
 package # hide from PAUSE
diff --git a/lib/DBIx/Class/Storage/DBI/ODBC/Firebird.pm b/lib/DBIx/Class/Storage/DBI/ODBC/Firebird.pm
index 2b555ba..91f7292 100644
--- a/lib/DBIx/Class/Storage/DBI/ODBC/Firebird.pm
+++ b/lib/DBIx/Class/Storage/DBI/ODBC/Firebird.pm
@@ -8,6 +8,7 @@ use base qw/
 /;
 use mro 'c3';
 use Try::Tiny;
+use DBIx::Class::_Util 'dbic_internal_try';
 use namespace::clean;
 
 =head1 NAME
@@ -48,7 +49,7 @@ sub _exec_svp_release { 1 }
 sub _exec_svp_rollback {
   my ($self, $name) = @_;
 
-  try {
+  dbic_internal_try {
     $self->_dbh->do("ROLLBACK TO SAVEPOINT $name")
   }
   catch {
diff --git a/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm b/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm
index 1713138..4ee00eb 100644
--- a/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm
+++ b/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm
@@ -9,6 +9,7 @@ use base qw/
 use mro 'c3';
 use Scalar::Util 'reftype';
 use Try::Tiny;
+use DBIx::Class::_Util 'dbic_internal_try';
 use DBIx::Class::Carp;
 use namespace::clean;
 
@@ -227,7 +228,7 @@ sub _run_connection_actions {
     !!$self->_using_dynamic_cursors
   ) {
     if ($use_dyncursors) {
-      try {
+      dbic_internal_try {
         my $dbh = $self->_dbh;
         local $dbh->{RaiseError} = 1;
         local $dbh->{PrintError} = 0;
diff --git a/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm b/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm
index 2bea8b9..30a9f54 100644
--- a/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm
+++ b/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm
@@ -7,9 +7,8 @@ use mro 'c3';
 use DBIx::Class::Carp;
 use Scope::Guard ();
 use Context::Preserve 'preserve_context';
-use Try::Tiny;
 use List::Util 'first';
-use DBIx::Class::_Util 'modver_gt_or_eq_and_lt';
+use DBIx::Class::_Util qw( modver_gt_or_eq_and_lt dbic_internal_try );
 use namespace::clean;
 
 __PACKAGE__->sql_limit_dialect ('RowNum');
@@ -273,12 +272,13 @@ sub _ping {
   local $dbh->{RaiseError} = 1;
   local $dbh->{PrintError} = 0;
 
-  return try {
+  ( dbic_internal_try {
     $dbh->do('select 1 from dual');
     1;
-  } catch {
-    0;
-  };
+  })
+    ? 1
+    : 0
+  ;
 }
 
 sub _dbh_execute {
diff --git a/lib/DBIx/Class/Storage/DBI/Replicated.pm b/lib/DBIx/Class/Storage/DBI/Replicated.pm
index 8328cf3..7d61118 100644
--- a/lib/DBIx/Class/Storage/DBI/Replicated.pm
+++ b/lib/DBIx/Class/Storage/DBI/Replicated.pm
@@ -21,6 +21,7 @@ use Hash::Merge;
 use List::Util qw/min max reduce/;
 use Context::Preserve 'preserve_context';
 use Try::Tiny;
+use DBIx::Class::_Util 'dbic_internal_try';
 
 use namespace::clean -except => 'meta';
 
@@ -699,7 +700,7 @@ sub execute_reliably {
   local $self->{read_handler} = $self->master;
 
   my $args = \@_;
-  return try {
+  return dbic_internal_try {
     $coderef->(@$args);
   } catch {
     $self->throw_exception("coderef returned an error: $_");
diff --git a/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm b/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm
index 9980b4d..7c82d28 100644
--- a/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm
+++ b/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm
@@ -7,6 +7,7 @@ use Scalar::Util 'reftype';
 use DBI ();
 use MooseX::Types::Moose qw/Num Int ClassName HashRef/;
 use DBIx::Class::Storage::DBI::Replicated::Types 'DBICStorageDBI';
+use DBIx::Class::_Util 'dbic_internal_try';
 use Try::Tiny;
 
 use namespace::clean -except => 'meta';
@@ -293,7 +294,7 @@ Returns 1 on success and undef on failure.
 sub _safely {
   my ($self, $replicant, $name, $code) = @_;
 
-  return try {
+  return dbic_internal_try {
     $code->();
     1;
   } catch {
diff --git a/lib/DBIx/Class/Storage/DBI/Replicated/WithDSN.pm b/lib/DBIx/Class/Storage/DBI/Replicated/WithDSN.pm
index 46b1430..cb4ad2a 100644
--- a/lib/DBIx/Class/Storage/DBI/Replicated/WithDSN.pm
+++ b/lib/DBIx/Class/Storage/DBI/Replicated/WithDSN.pm
@@ -4,7 +4,8 @@ use Moose::Role;
 use Scalar::Util 'reftype';
 requires qw/_query_start/;
 
-use Try::Tiny;
+use DBIx::Class::_Util 'dbic_internal_try';
+
 use namespace::clean -except => 'meta';
 
 =head1 NAME
@@ -33,7 +34,7 @@ Add C<DSN: > to debugging output.
 around '_query_start' => sub {
   my ($method, $self, $sql, @bind) = @_;
 
-  my $dsn = (try { $self->dsn }) || $self->_dbi_connect_info->[0];
+  my $dsn = (dbic_internal_try { $self->dsn }) || $self->_dbi_connect_info->[0];
 
   my($op, $rest) = (($sql=~m/^(\w+)(.+)$/),'NOP', 'NO SQL');
   my $storage_type = $self->can('active') ? 'REPLICANT' : 'MASTER';
@@ -42,7 +43,7 @@ around '_query_start' => sub {
     if ((reftype($dsn)||'') ne 'CODE') {
       "$op [DSN_$storage_type=$dsn]$rest";
     }
-    elsif (my $id = try { $self->id }) {
+    elsif (my $id = dbic_internal_try { $self->id }) {
       "$op [$storage_type=$id]$rest";
     }
     else {
diff --git a/lib/DBIx/Class/Storage/DBI/SQLAnywhere.pm b/lib/DBIx/Class/Storage/DBI/SQLAnywhere.pm
index 9cdd038..3d054bb 100644
--- a/lib/DBIx/Class/Storage/DBI/SQLAnywhere.pm
+++ b/lib/DBIx/Class/Storage/DBI/SQLAnywhere.pm
@@ -5,6 +5,7 @@ use warnings;
 use base qw/DBIx::Class::Storage::DBI::UniqueIdentifier/;
 use mro 'c3';
 use List::Util 'first';
+use DBIx::Class::_Util 'dbic_internal_try';
 use Try::Tiny;
 use namespace::clean;
 
@@ -76,7 +77,7 @@ sub _prefetch_autovalues {
     my $table_name = $source->from;
     $table_name    = $$table_name if ref $table_name;
 
-    my ($identity) = try {
+    my ($identity) = dbic_internal_try {
       $dbh->selectrow_array("SELECT GET_IDENTITY('$table_name')")
     };
 
@@ -139,7 +140,7 @@ sub select_single {
 
 sub build_datetime_parser {
   my $self = shift;
-  try {
+  dbic_internal_try {
     require DateTime::Format::Strptime;
   }
   catch {
diff --git a/lib/DBIx/Class/Storage/DBI/SQLite.pm b/lib/DBIx/Class/Storage/DBI/SQLite.pm
index 4311bdf..28e9a08 100644
--- a/lib/DBIx/Class/Storage/DBI/SQLite.pm
+++ b/lib/DBIx/Class/Storage/DBI/SQLite.pm
@@ -7,7 +7,7 @@ use base qw/DBIx::Class::Storage::DBI/;
 use mro 'c3';
 
 use SQL::Abstract 'is_plain_value';
-use DBIx::Class::_Util qw(modver_gt_or_eq sigwarn_silencer);
+use DBIx::Class::_Util qw(modver_gt_or_eq sigwarn_silencer dbic_internal_try);
 use DBIx::Class::Carp;
 use Try::Tiny;
 use namespace::clean;
@@ -168,26 +168,29 @@ sub _ping {
   unless ($DBD::SQLite::__DBIC_TXN_SYNC_SANE__) {
     # since we do not have access to sqlite3_get_autocommit(), do a trick
     # to attempt to *safely* determine what state are we *actually* in.
-    # FIXME
-    # also using T::T here leads to bizarre leaks - will figure it out later
-    my $really_not_in_txn = do {
-      local $@;
+
+    my $really_not_in_txn;
+
+    # not assigning RV directly to env above, because this causes a bizarre
+    # leak of the catch{} cref on older perls... wtf
+    dbic_internal_try {
 
       # older versions of DBD::SQLite do not properly detect multiline BEGIN/COMMIT
       # statements to adjust their {AutoCommit} state. Hence use such a statement
       # pair here as well, in order to escape from poking {AutoCommit} needlessly
       # https://rt.cpan.org/Public/Bug/Display.html?id=80087
-      eval {
-        # will fail instantly if already in a txn
-        $dbh->do("-- multiline\nBEGIN");
-        $dbh->do("-- multiline\nCOMMIT");
-        1;
-      } or do {
-        ($@ =~ /transaction within a transaction/)
-          ? 0
-          : undef
-        ;
-      };
+      #
+      # will fail instantly if already in a txn
+      $dbh->do("-- multiline\nBEGIN");
+      $dbh->do("-- multiline\nCOMMIT");
+
+      $really_not_in_txn = 1;
+    }
+    catch {
+      $really_not_in_txn = ( $_[0] =~ qr/transaction within a transaction/
+        ? 0
+        : undef
+      );
     };
 
     # if we were unable to determine this - we may very well be dead
@@ -212,7 +215,7 @@ sub _ping {
   }
 
   # do the actual test and return on no failure
-  ( $ping_fail ||= ! try { $dbh->do('SELECT * FROM sqlite_master LIMIT 1'); 1 } )
+  ( $ping_fail ||= ! dbic_internal_try { $dbh->do('SELECT * FROM sqlite_master LIMIT 1'); 1 } )
     or return 1; # the actual RV of _ping()
 
   # ping failed (or so it seems) - need to do some cleanup
@@ -221,8 +224,7 @@ sub _ping {
   # keeps the actual file handle open. We don't really want this to happen,
   # so force-close the handle via DBI itself
   #
-  local $@; # so that we do not clobber the real error as set above
-  eval { $dbh->disconnect }; # if it fails - it fails
+  dbic_internal_try { $dbh->disconnect }; # if it fails - it fails
   undef; # the actual RV of _ping()
 }
 
diff --git a/lib/DBIx/Class/Storage/DBI/Sybase.pm b/lib/DBIx/Class/Storage/DBI/Sybase.pm
index 6288325..9072b38 100644
--- a/lib/DBIx/Class/Storage/DBI/Sybase.pm
+++ b/lib/DBIx/Class/Storage/DBI/Sybase.pm
@@ -2,6 +2,7 @@ package DBIx::Class::Storage::DBI::Sybase;
 
 use strict;
 use warnings;
+use DBIx::Class::_Util 'dbic_internal_try';
 use Try::Tiny;
 use namespace::clean;
 
@@ -26,7 +27,7 @@ sub _rebless { shift->_determine_connector_driver('Sybase') }
 sub _get_rdbms_name {
   my $self = shift;
 
-  try {
+  dbic_internal_try {
     my $name = $self->_get_dbh->selectrow_arrayref('sp_server_info @attribute_id=1')->[2];
 
     if ($name) {
@@ -77,9 +78,9 @@ sub _ping {
 
 # FIXME if the main connection goes stale, does opening another for this statement
 # really determine anything?
-
+# FIXME (2) THIS MAKES 0 SENSE!!! Need to test later
   if ($dbh->{syb_no_child_con}) {
-    return try {
+    return dbic_internal_try {
       $self->_connect->do('select 1');
       1;
     }
@@ -88,13 +89,14 @@ sub _ping {
     };
   }
 
-  return try {
-    $dbh->do('select 1');
-    1;
-  }
-  catch {
-    0;
-  };
+  return (
+    (dbic_internal_try {
+      $dbh->do('select 1');
+      1;
+    })
+      ? 1
+      : 0
+  );
 }
 
 sub _set_max_connect {
diff --git a/lib/DBIx/Class/Storage/DBI/Sybase/ASE.pm b/lib/DBIx/Class/Storage/DBI/Sybase/ASE.pm
index 7756df7..3479ff3 100644
--- a/lib/DBIx/Class/Storage/DBI/Sybase/ASE.pm
+++ b/lib/DBIx/Class/Storage/DBI/Sybase/ASE.pm
@@ -16,7 +16,7 @@ use Sub::Name();
 use Data::Dumper::Concise 'Dumper';
 use Try::Tiny;
 use Context::Preserve 'preserve_context';
-use DBIx::Class::_Util 'sigwarn_silencer';
+use DBIx::Class::_Util qw( sigwarn_silencer dbic_internal_try );
 use namespace::clean;
 
 __PACKAGE__->sql_limit_dialect ('GenericSubQ');
@@ -596,7 +596,7 @@ sub _insert_bulk {
   });
 
   my $exception = '';
-  try {
+  dbic_internal_try {
     my $bulk = $self->_bulk_storage;
 
     my $guard = $bulk->txn_scope_guard;
@@ -722,7 +722,7 @@ sub _remove_blob_cols_array {
 sub _update_blobs {
   my ($self, $source, $blob_cols, $where) = @_;
 
-  my @primary_cols = try
+  my @primary_cols = dbic_internal_try
     { $source->_pri_cols_or_die }
     catch {
       $self->throw_exception("Cannot update TEXT/IMAGE column(s): $_")
@@ -755,7 +755,7 @@ sub _insert_blobs {
 
   my $table = $source->name;
 
-  my @primary_cols = try
+  my @primary_cols = dbic_internal_try
     { $source->_pri_cols_or_die }
     catch {
       $self->throw_exception("Cannot update TEXT/IMAGE column(s): $_")
@@ -785,7 +785,7 @@ sub _insert_blobs {
       );
     }
 
-    try {
+    dbic_internal_try {
       do {
         $sth->func('CS_GET', 1, 'ct_data_info') or die $sth->errstr;
       } while $sth->fetch;
diff --git a/lib/DBIx/Class/Storage/DBI/Sybase/FreeTDS.pm b/lib/DBIx/Class/Storage/DBI/Sybase/FreeTDS.pm
index c4fae15..9db543c 100644
--- a/lib/DBIx/Class/Storage/DBI/Sybase/FreeTDS.pm
+++ b/lib/DBIx/Class/Storage/DBI/Sybase/FreeTDS.pm
@@ -4,7 +4,7 @@ use strict;
 use warnings;
 use base qw/DBIx::Class::Storage::DBI::Sybase/;
 use mro 'c3';
-use Try::Tiny;
+use DBIx::Class::_Util 'dbic_internal_try';
 use namespace::clean;
 
 =head1 NAME
@@ -67,7 +67,7 @@ sub set_textsize {
   my $text_size =
     shift
       ||
-    try { $self->_dbic_cinnect_attributes->{LongReadLen} }
+    dbic_internal_try { $self->_dbic_connect_attributes->{LongReadLen} }
       ||
     32768; # the DBD::Sybase default
 
diff --git a/lib/DBIx/Class/_Util.pm b/lib/DBIx/Class/_Util.pm
index 3c14189..c22a5c6 100644
--- a/lib/DBIx/Class/_Util.pm
+++ b/lib/DBIx/Class/_Util.pm
@@ -79,7 +79,8 @@ 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
-  scope_guard is_exception detected_reinvoked_destructor
+  scope_guard detected_reinvoked_destructor
+  is_exception dbic_internal_try
   quote_sub qsub perlstring serialize deep_clone
   UNRESOLVABLE_CONDITION
 );
@@ -229,6 +230,85 @@ sub is_exception ($) {
 }
 
 {
+  my $callstack_state;
+
+  # Recreate the logic of try(), while reusing the catch()/finally() as-is
+  #
+  # FIXME: We need to move away from Try::Tiny entirely (way too heavy and
+  # yes, shows up ON TOP of profiles) but this is a batle for another maint
+  sub dbic_internal_try (&;@) {
+
+    my $try_cref = shift;
+    my $catch_cref = undef;  # apparently this is a thing... https://rt.perl.org/Public/Bug/Display.html?id=119311
+
+    for my $arg (@_) {
+
+      if( ref($arg) eq 'Try::Tiny::Catch' ) {
+
+        croak 'dbic_internal_try() may not be followed by multiple catch() blocks'
+          if $catch_cref;
+
+        $catch_cref = $$arg;
+      }
+      elsif ( ref($arg) eq 'Try::Tiny::Finally' ) {
+        croak 'dbic_internal_try() does not support finally{}';
+      }
+      else {
+        croak(
+          'dbic_internal_try() encountered an unexpected argument '
+        . "'@{[ defined $arg ? $arg : 'UNDEF' ]}' - perhaps "
+        . 'a missing semi-colon before or ' # trailing space important
+        );
+      }
+    }
+
+    my $wantarray = wantarray;
+    my $preexisting_exception = $@;
+
+    my @ret;
+    my $all_good = eval {
+      $@ = $preexisting_exception;
+
+      local $callstack_state->{in_internal_try} = 1
+        unless $callstack_state->{in_internal_try};
+
+      # always unset - someone may have snuck it in
+      local $SIG{__DIE__}
+        if $SIG{__DIE__};
+
+
+      if( $wantarray ) {
+        @ret = $try_cref->();
+      }
+      elsif( defined $wantarray ) {
+        $ret[0] = $try_cref->();
+      }
+      else {
+        $try_cref->();
+      }
+
+      1;
+    };
+
+    my $exception = $@;
+    $@ = $preexisting_exception;
+
+    if ( $all_good ) {
+      return $wantarray ? @ret : $ret[0]
+    }
+    elsif ( $catch_cref ) {
+      for ( $exception ) {
+        return $catch_cref->($exception);
+      }
+    }
+
+    return;
+  }
+
+  sub in_internal_try { !! $callstack_state->{in_internal_try} }
+}
+
+{
   my $destruction_registry = {};
 
   sub CLONE {
diff --git a/lib/SQL/Translator/Parser/DBIx/Class.pm b/lib/SQL/Translator/Parser/DBIx/Class.pm
index 59aec2a..4cc21f0 100644
--- a/lib/SQL/Translator/Parser/DBIx/Class.pm
+++ b/lib/SQL/Translator/Parser/DBIx/Class.pm
@@ -15,6 +15,7 @@ $DEBUG = 0 unless defined $DEBUG;
 use Exporter;
 use SQL::Translator::Utils qw(debug normalize_name);
 use DBIx::Class::Carp qw/^SQL::Translator|^DBIx::Class|^Try::Tiny/;
+use DBIx::Class::_Util 'dbic_internal_try';
 use DBIx::Class::Exception;
 use Class::C3::Componentised;
 use Scalar::Util 'blessed';
@@ -54,7 +55,7 @@ sub parse {
     DBIx::Class::Exception->throw('No DBIx::Class::Schema') unless ($dbicschema);
 
     if (!ref $dbicschema) {
-      try {
+      dbic_internal_try {
         Class::C3::Componentised->ensure_class_loaded($dbicschema)
       } catch {
         DBIx::Class::Exception->throw("Can't load $dbicschema: $_");
@@ -175,7 +176,7 @@ sub parse {
             # Ignore any rel cond that isn't a straight hash
             next unless ref $rel_info->{cond} eq 'HASH';
 
-            my $relsource = try { $source->related_source($rel) };
+            my $relsource = dbic_internal_try { $source->related_source($rel) };
             unless ($relsource) {
               carp "Ignoring relationship '$rel' on '$moniker' - related resultsource '$rel_info->{class}' is not registered with this schema\n";
               next;
diff --git a/maint/travis-ci_scripts/20_install.bash b/maint/travis-ci_scripts/20_install.bash
index 79c4b26..2d6fbf2 100755
--- a/maint/travis-ci_scripts/20_install.bash
+++ b/maint/travis-ci_scripts/20_install.bash
@@ -91,6 +91,7 @@ if [[ "$POISON_ENV" = "true" ]] ; then
 
   # some extra pollutants
   toggle_booleans+=( \
+    DBICTEST_ASSERT_NO_SPURIOUS_EXCEPTION_ACTION \
     DBICTEST_SQLITE_USE_FILE \
     DBICTEST_RUN_ALL_TESTS \
     DBICTEST_SQLITE_REVERSE_DEFAULT_ORDER \
diff --git a/t/34exception_action.t b/t/34exception_action.t
index b35c7dc..d7885d5 100644
--- a/t/34exception_action.t
+++ b/t/34exception_action.t
@@ -105,7 +105,7 @@ for my $ap (qw(
     isa_ok $@, $ap;
   } $exp_warn, 'proper warning on antipattern encountered within exception_action';
 
-  # and make sure that the retrhow works
+  # and make sure that the rethrow works
   $schema->exception_action(sub { die @_ });
   warnings_like {
     eval {
diff --git a/t/61findnot.t b/t/61findnot.t
index 89070ce..ab709e3 100644
--- a/t/61findnot.t
+++ b/t/61findnot.t
@@ -53,7 +53,11 @@ for my $key ('', 'primary') {
 }
 
 # collapsing and non-collapsing are separate codepaths, thus the separate tests
-
+my $ea_count = 0;
+$schema->exception_action(sub {
+  $ea_count++;
+  die @_;
+});
 
 $artist_rs = $schema->resultset("Artist");
 
@@ -79,6 +83,10 @@ for (1, 0) {
   ;
 }
 
+is( $ea_count, 1, "exception action invoked the expected amount of times (just the exception)" );
+
+$schema->exception_action(undef);
+
 
 $artist_rs = $schema->resultset("Artist")->search({}, { prefetch => 'cds' });
 
diff --git a/t/lib/DBICTest/BaseSchema.pm b/t/lib/DBICTest/BaseSchema.pm
index 1ff5e98..f210c2d 100644
--- a/t/lib/DBICTest/BaseSchema.pm
+++ b/t/lib/DBICTest/BaseSchema.pm
@@ -12,6 +12,52 @@ use DBICTest::Util::LeakTracer qw(populate_weakregistry assert_empty_weakregistr
 use DBICTest::Util qw( local_umask await_flock dbg DEBUG_TEST_CONCURRENCY_LOCKS );
 use namespace::clean;
 
+if( $ENV{DBICTEST_ASSERT_NO_SPURIOUS_EXCEPTION_ACTION} ) {
+  __PACKAGE__->exception_action( sub {
+
+    my ( $fr_num, $disarmed, $throw_exception_fr_num );
+    while( ! $disarmed and my @fr = caller(++$fr_num) ) {
+
+      $throw_exception_fr_num ||= (
+        $fr[3] eq 'DBIx::Class::ResultSource::throw_exception'
+          and
+        $fr_num
+      );
+
+      $disarmed = !! (
+        $fr[1] =~ / \A (?: \. [\/\\] )? x?t [\/\\] .+ \.t \z /x
+          and
+        (
+          $fr[3] =~ /\A (?:
+            Test::Exception::throws_ok
+              |
+            Test::Exception::dies_ok
+              |
+            Try::Tiny::try
+              |
+            \Q(eval)\E
+          ) \z /x
+            or
+          (
+            $fr[3] eq 'Test::Exception::lives_ok'
+              and
+            ( $::TODO or Test::Builder->new->in_todo )
+          )
+        )
+      );
+    }
+
+    Test::Builder->new->ok(0, join "\n",
+      'Unexpected &exception_action invocation',
+      '',
+      '  You almost certainly used eval/try instead of dbic_internal_try()',
+      "  Adjust *one* of the eval-ish constructs in the callstack starting" . DBICTest::Util::stacktrace($throw_exception_fr_num||())
+    ) unless $disarmed;
+
+    DBIx::Class::Exception->throw( $_[0] );
+  })
+}
+
 sub capture_executed_sql_bind {
   my ($self, $cref) = @_;
 
diff --git a/t/lib/DBICTest/RunMode.pm b/t/lib/DBICTest/RunMode.pm
index fb36805..114d79a 100644
--- a/t/lib/DBICTest/RunMode.pm
+++ b/t/lib/DBICTest/RunMode.pm
@@ -25,6 +25,41 @@ BEGIN {
       &$ov;
     };
   }
+
+  if (
+    $ENV{DBICTEST_ASSERT_NO_SPURIOUS_EXCEPTION_ACTION}
+      or
+    # keep it always on during CI
+    (
+      ($ENV{TRAVIS}||'') eq 'true'
+        and
+      ($ENV{TRAVIS_REPO_SLUG}||'') =~ m|\w+/dbix-class$|
+    )
+  ) {
+    require Try::Tiny;
+    my $orig = \&Try::Tiny::try;
+
+    no warnings 'redefine';
+    *Try::Tiny::try = sub (&;@) {
+      my ($fr, $first_pkg) = 0;
+      while( $first_pkg = caller($fr++) ) {
+        last if $first_pkg !~ /^
+          __ANON__
+            |
+          \Q(eval)\E
+        $/x;
+      }
+
+      if ($first_pkg =~ /DBIx::Class/) {
+        require Test::Builder;
+        Test::Builder->new->ok(0,
+          'Using try{} within DBIC internals is a mistake - use dbic_internal_try{} instead'
+        );
+      }
+
+      goto $orig;
+    };
+  }
 }
 
 use Path::Class qw/file dir/;
diff --git a/t/storage/reconnect.t b/t/storage/reconnect.t
index 4fa8384..fc97ebd 100644
--- a/t/storage/reconnect.t
+++ b/t/storage/reconnect.t
@@ -16,6 +16,12 @@ my $db_tmp  = "$db_orig.tmp";
 # Set up the "usual" sqlite for DBICTest
 my $schema = DBICTest->init_schema( sqlite_use_file => 1 );
 
+my $exception_action_count;
+$schema->exception_action(sub {
+  $exception_action_count++;
+  die @_;
+});
+
 # Make sure we're connected by doing something
 my @art = $schema->resultset("Artist")->search({ }, { order_by => { -desc => 'name' }});
 cmp_ok(@art, '==', 3, "Three artists returned");
@@ -92,6 +98,8 @@ for my $ctx (keys %$ctx_map) {
 
   # start disconnected and then connected
   $schema->storage->disconnect;
+  $exception_action_count = 0;
+
   for (1, 2) {
     my $disarmed;
 
@@ -106,6 +114,8 @@ for my $ctx (keys %$ctx_map) {
       isa_ok ($schema->resultset('Artist')->next, 'DBICTest::Artist');
     }, @$args) });
   }
+
+  is( $exception_action_count, 0, 'exception_action never called' );
 };
 
 # make sure RT#110429 does not recur on manual DBI-side disconnect
@@ -139,6 +149,7 @@ for my $cref (
   note( "Testing with " . B::Deparse->new->coderef2text($cref) );
 
   $schema->storage->disconnect;
+  $exception_action_count = 0;
 
   ok( !$schema->storage->connected, 'Not connected' );
 
@@ -152,6 +163,22 @@ for my $cref (
   ok( !$schema->storage->connected, 'Not connected as a result of failed rollback' );
 
   is( $schema->storage->transaction_depth, undef, "Depth expectedly unknown after failed rollbacks" );
+
+  is( $exception_action_count, 1, "exception_action called only once" );
+}
+
+# check exception_action under tenacious disconnect
+{
+  $schema->storage->disconnect;
+  $exception_action_count = 0;
+
+  throws_ok { $schema->txn_do(sub {
+    $schema->storage->_dbh->disconnect;
+
+    $schema->resultset('Artist')->next;
+  })} qr/prepare on inactive database handle/;
+
+  is( $exception_action_count, 1, "exception_action called only once" );
 }
 
 # check that things aren't crazy with a non-violent disconnect