[Bast-commits] r7943 - in DBIx-Class/0.08/trunk: lib/DBIx/Class lib/DBIx/Class/CDBICompat t

[ribasushi at dev.catalyst.perl.org]

Author: ribasushi
Date: 2009-11-23 15:30:13 +0000 (Mon, 23 Nov 2009)
New Revision: 7943

Modified:
   DBIx-Class/0.08/trunk/lib/DBIx/Class/CDBICompat/Constructor.pm
   DBIx-Class/0.08/trunk/lib/DBIx/Class/SQLAHacks.pm
   DBIx-Class/0.08/trunk/lib/DBIx/Class/Schema.pm
   DBIx-Class/0.08/trunk/t/95sql_maker.t
Log:
Add missing Sub::Name invocations and improve the SQLA Carp overrides

Modified: DBIx-Class/0.08/trunk/lib/DBIx/Class/CDBICompat/Constructor.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/CDBICompat/Constructor.pm	2009-11-23 12:25:11 UTC (rev 7942)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/CDBICompat/Constructor.pm	2009-11-23 15:30:13 UTC (rev 7943)
@@ -3,6 +3,8 @@
 
 use base qw(DBIx::Class::CDBICompat::ImaDBI);
 
+use Sub::Name();
+
 use strict;
 use warnings;
 
@@ -22,7 +24,7 @@
     return carp("$method already exists in $class")
             if *$meth{CODE};
 
-    *$meth = sub {
+    *$meth = Sub::Name::subname $meth => sub {
             my $self = shift;
             $self->sth_to_objects($self->sql_Retrieve($fragment), \@_);
     };

Modified: DBIx-Class/0.08/trunk/lib/DBIx/Class/SQLAHacks.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/SQLAHacks.pm	2009-11-23 12:25:11 UTC (rev 7942)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/SQLAHacks.pm	2009-11-23 15:30:13 UTC (rev 7943)
@@ -9,6 +9,7 @@
 use strict;
 use warnings;
 use Carp::Clan qw/^DBIx::Class|^SQL::Abstract/;
+use Sub::Name();
 
 BEGIN {
   # reinstall the carp()/croak() functions imported into SQL::Abstract
@@ -18,17 +19,15 @@
   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 \s at/x) {
-        __PACKAGE__->can($f)->(@_);
-      }
-      else {
-        $orig->(@_);
-      }
-    }
+    *{"SQL::Abstract::$f"} = Sub::Name::subname "SQL::Abstract::$f" =>
+      sub {
+        if (Carp::longmess() =~ /DBIx::Class::SQLAHacks::[\w]+ .+? called \s at/x) {
+          __PACKAGE__->can($f)->(@_);
+        }
+        else {
+          goto $orig;
+        }
+      };
   }
 }
 

Modified: DBIx-Class/0.08/trunk/lib/DBIx/Class/Schema.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/Schema.pm	2009-11-23 12:25:11 UTC (rev 7942)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/Schema.pm	2009-11-23 15:30:13 UTC (rev 7943)
@@ -908,7 +908,7 @@
     no strict 'refs';
     no warnings 'redefine';
     foreach my $meth (qw/class source resultset/) {
-      *{"${target}::${meth}"} =
+      *{"${target}::${meth}"} = Sub::Name::subname "${target}::${meth}" =>
         sub { shift->schema->$meth(@_) };
     }
   }

Modified: DBIx-Class/0.08/trunk/t/95sql_maker.t
===================================================================
--- DBIx-Class/0.08/trunk/t/95sql_maker.t	2009-11-23 12:25:11 UTC (rev 7942)
+++ DBIx-Class/0.08/trunk/t/95sql_maker.t	2009-11-23 15:30:13 UTC (rev 7943)
@@ -70,8 +70,7 @@
 }
 
 # Make sure the carp/croak override in SQLA works (via SQLAHacks)
-my $file = __FILE__;
-$file = "\Q$file\E";
+my $file = quotemeta (__FILE__);
 throws_ok (sub {
   $schema->resultset ('Artist')->search ({}, { order_by => { -asc => 'stuff', -desc => 'staff' } } )->as_query;
 }, qr/$file/, 'Exception correctly croak()ed');