[Bast-commits] r6466 - in DBIx-Class/0.08/branches/order_by_refactor: lib/DBIx/Class t

[ribasushi at dev.catalyst.perl.org]

Author: ribasushi
Date: 2009-05-30 17:13:23 +0000 (Sat, 30 May 2009)
New Revision: 6466

Modified:
   DBIx-Class/0.08/branches/order_by_refactor/lib/DBIx/Class/SQLAHacks.pm
   DBIx-Class/0.08/branches/order_by_refactor/t/95sql_maker.t
Log:
Evil hack to make Carp::Clan work throughout SQLA as well

Modified: DBIx-Class/0.08/branches/order_by_refactor/lib/DBIx/Class/SQLAHacks.pm
===================================================================
--- DBIx-Class/0.08/branches/order_by_refactor/lib/DBIx/Class/SQLAHacks.pm	2009-05-30 16:35:46 UTC (rev 6465)
+++ DBIx-Class/0.08/branches/order_by_refactor/lib/DBIx/Class/SQLAHacks.pm	2009-05-30 17:13:23 UTC (rev 6466)
@@ -4,8 +4,29 @@
 use base qw/SQL::Abstract::Limit/;
 use strict;
 use warnings;
-use Carp::Clan qw/^DBIx::Class/;
+use Carp::Clan qw/^DBIx::Class|^SQL::Abstract/;
 
+BEGIN {
+  # reinstall the carp()/croak() functions imported into SQL::Abstract
+  # as Carp and Carp::Clan 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"};
+    *{"SQL::Abstract::$f"} = sub {
+
+      local $Carp::CarpLevel = 1;   # even though Carp::Clan ignores this, $orig will not
+
+      if (Carp::longmess() =~ /DBIx::Class::SQLAHacks::[\w]+\(\) called/) {
+        __PACKAGE__->can($f)->(@_);
+      }
+      else {
+        $orig->(@_);
+      }
+    }
+  }
+}
+
 sub new {
   my $self = shift->SUPER::new(@_);
 

Modified: DBIx-Class/0.08/branches/order_by_refactor/t/95sql_maker.t
===================================================================
--- DBIx-Class/0.08/branches/order_by_refactor/t/95sql_maker.t	2009-05-30 16:35:46 UTC (rev 6465)
+++ DBIx-Class/0.08/branches/order_by_refactor/t/95sql_maker.t	2009-05-30 17:13:23 UTC (rev 6466)
@@ -2,16 +2,12 @@
 use warnings;
 
 use Test::More;
+use Test::Exception;
 
 use lib qw(t/lib);
 use DBIC::SqlMakerTest;
 
-BEGIN {
-    eval "use DBD::SQLite";
-    plan $@
-        ? ( skip_all => 'needs DBD::SQLite for testing' )
-        : ( tests => 3 );
-}
+plan tests => 4;
 
 use_ok('DBICTest');
 
@@ -52,3 +48,9 @@
     'sql_maker passes arrayrefs in update'
   );
 }
+
+# Make sure the carp/croak override in SQLA works (via SQLAHacks)
+my $file = __FILE__;
+throws_ok (sub {
+  $schema->resultset ('Artist')->search ({}, { order_by => { -asc => 'stuff', -desc => 'staff' } } )->as_query;
+}, qr/$file/, 'Exception correctly croak()ed');