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

[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Carp.pm

diff --git a/lib/DBIx/Class/Carp.pm b/lib/DBIx/Class/Carp.pm
index 6ae6199..fbd37e5 100644 (file)
--- a/lib/DBIx/Class/Carp.pm
+++ b/lib/DBIx/Class/Carp.pm
@@ -21,7 +21,7 @@ sub __find_caller {
   my $fr_num = 1; # skip us and the calling carp*
 
   my (@f, $origin);
-  while (@f = caller($fr_num++)) {
+  while (@f = CORE::caller($fr_num++)) {
 
     next if
       ( $f[3] eq '(eval)' or $f[3] =~ /::__ANON__$/ );
@@ -33,9 +33,9 @@ sub __find_caller {
         and
 #############################
 # 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 )$/x
+      $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)$/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;
 
@@ -54,11 +54,15 @@ sub __find_caller {
     ? "at $f[1] line $f[2]"
     : Carp::longmess()
   ;
-  $origin ||= '{UNKNOWN}';
 
   return (
     $site,
-    $origin =~ /::/ ? "$origin(): " : "$origin: ", # cargo-cult from Carp::Clan
+    (
+      # cargo-cult from Carp::Clan
+      ! defined $origin   ? ''
+    : $origin =~ /::/     ? "$origin(): "
+                          : "$origin: "
+    ),
   );
 };