From: Peter Rabbitson Date: Sat, 30 May 2009 17:13:23 +0000 (+0000) Subject: Evil hack to make Carp::Clan work throughout SQLA as well X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b2b22cd666685403e0c926415efa92e7420e18c4;p=dbsrgits%2FDBIx-Class-Historic.git Evil hack to make Carp::Clan work throughout SQLA as well --- diff --git a/lib/DBIx/Class/SQLAHacks.pm b/lib/DBIx/Class/SQLAHacks.pm index f05970b..c0b9937 100644 --- a/lib/DBIx/Class/SQLAHacks.pm +++ b/lib/DBIx/Class/SQLAHacks.pm @@ -4,7 +4,28 @@ package # Hide from PAUSE 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(@_); diff --git a/t/95sql_maker.t b/t/95sql_maker.t index 48f66ac..d99d201 100644 --- a/t/95sql_maker.t +++ b/t/95sql_maker.t @@ -2,16 +2,12 @@ use strict; 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 @@ my $sql_maker = $schema->storage->sql_maker; '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');