From: Peter Rabbitson <ribasushi@cpan.org>
Date: Fri, 18 Mar 2011 09:07:15 +0000 (+0100)
Subject: Fixup SQLA monkeypatch in anticipation of new SQLA version
X-Git-Tag: v0.08191~57
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=2ea6032acc08fc61cf6d12e787e7ee6b368b74bc;p=dbsrgits%2FDBIx-Class.git

Fixup SQLA monkeypatch in anticipation of new SQLA version
---

diff --git a/Changes b/Changes
index b4693a4..49460cd 100644
--- a/Changes
+++ b/Changes
@@ -29,6 +29,8 @@ Revision history for DBIx::Class
         - Fix exiting via next warnings in ResultSource::sequence()
         - Fix stripping of table qualifiers in update/delete in arrayref
           condition elements
+        - Change SQLMaker carp-monkeypatch to be compatible with versions
+          of SQL::Abstract >= 1.73
 
     * Misc
         - Only load Class::C3 and friends if necessary ($] < 5.010)
diff --git a/lib/DBIx/Class/SQLMaker.pm b/lib/DBIx/Class/SQLMaker.pm
index 1340165..08acbb2 100644
--- a/lib/DBIx/Class/SQLMaker.pm
+++ b/lib/DBIx/Class/SQLMaker.pm
@@ -55,24 +55,19 @@ sub _quote_chars {
 }
 
 BEGIN {
-  # reinstall the carp()/croak() functions imported into SQL::Abstract
-  # as Carp and Carp::Clan do not like each other much
+  # reinstall the belch()/puke() functions of SQL::Abstract with custom versions
+  # that use Carp::Clan instead of plain Carp (they do not like each other much)
   no warnings qw/redefine/;
-  no strict qw/refs/;
-  for my $f (qw/carp croak/) {
-
-    my $orig = \&{"SQL::Abstract::$f"};
-    my $clan_import = \&{$f};
-    *{"SQL::Abstract::$f"} = subname "SQL::Abstract::$f" =>
-      sub {
-        if (Carp::longmess() =~ /DBIx::Class::SQLMaker::[\w]+ .+? called \s at/x) {
-          goto $clan_import;
-        }
-        else {
-          goto $orig;
-        }
-      };
-  }
+
+  *SQL::Abstract::belch = subname 'SQL::Abstract::belch' => sub (@) {
+    my($func) = (caller(1))[3];
+    carp "[$func] Warning: ", @_;
+  };
+
+  *SQL::Abstract::puke = subname 'SQL::Abstract::puke' => sub (@) {
+    my($func) = (caller(1))[3];
+    croak "[$func] Fatal: ", @_;
+  };
 
   # Current SQLA pollutes its namespace - clean for the time being
   namespace::clean->clean_subroutines(qw/SQL::Abstract carp croak confess/);