AUTHORS

@@ -112,6 +112,7 @@ kd: Kieren Diment <diment@gmail.com>
 kentnl: Kent Fredric <kentnl@cpan.org>
 kkane: Kevin L. Kane <kevin.kane@gmail.com>
 konobi: Scott McWhirter <konobi@cpan.org>
+lamoz: Konstantin A. Pustovalov <konstantin.pustovalov@gmail.com>
 Lasse Makholm <lasse@unity3d.com>
 lejeunerenard: Sean Zellmer <sean@lejeunerenard.com>
 littlesavage: Alexey Illarionov <littlesavage@orionet.ru>

Changes

@@ -17,6 +17,8 @@ Revision history for DBIx::Class
     * Fixes
         - Ensure failing on_connect* / on_disconnect* are dealt with properly,
           notably on_connect* failures now properly abort the entire connect
+        - Make sure exception objects stringifying to '' are properly handled
+          and warned about (GH#15)
         - Fix corner case of stringify-only overloaded objects being used in
           create()/populate()
         - Fix several corner cases with Many2Many over custom relationships

lib/DBIx/Class/Schema.pm

@@ -8,7 +8,7 @@ use base 'DBIx::Class';
 use DBIx::Class::Carp;
 use Try::Tiny;
 use Scalar::Util qw/weaken blessed/;
-use DBIx::Class::_Util qw(refcount quote_sub);
+use DBIx::Class::_Util qw(refcount quote_sub is_exception);
 use Devel::GlobalDestruction;
 use namespace::clean;
 
@@ -1055,26 +1055,37 @@ default behavior will provide a detailed stack trace.
 =cut
 
 sub throw_exception {
-  my $self = shift;
+  my ($self, @args) = @_;
 
   if (my $act = $self->exception_action) {
-    if ($act->(@_)) {
-      DBIx::Class::Exception->throw(
+    try {
+      # if it throws - good, we'll go down to the catch
+      # if it doesn't - do different things depending on RV truthiness
+      if( $act->(@args) ) {
+        $args[0] = (
           "Invocation of the exception_action handler installed on $self did *not*"
         .' result in an exception. DBIx::Class is unable to function without a reliable'
         .' exception mechanism, ensure that exception_action does not hide exceptions'
-        ." (original error: $_[0])"
-      );
-    }
+        ." (original error: $args[0])"
+        );
+      }
+      else {
+        carp_unique (
+          "The exception_action handler installed on $self returned false instead"
+        .' of throwing an exception. This behavior has been deprecated, adjust your'
+        .' handler to always rethrow the supplied error.'
+        );
+      }
+    } catch {
+      # We call this to get the necessary warnings emitted and disregard the RV
+      # as it's definitely an exception if we got as far as catch{}
+      is_exception($_);
 
-    carp_unique (
-      "The exception_action handler installed on $self returned false instead"
-    .' of throwing an exception. This behavior has been deprecated, adjust your'
-    .' handler to always rethrow the supplied error.'
-    );
+      die $_;
+    };
   }
 
-  DBIx::Class::Exception->throw($_[0], $self->stacktrace);
+  DBIx::Class::Exception->throw( $args[0], $self->stacktrace );
 }
 
 =head2 deploy

lib/DBIx/Class/_Util.pm

@@ -165,6 +165,27 @@ sub is_exception ($) {
       die $suberror
     }
   }
+  elsif (
+    # a ref evaluating to '' is definitively a "null object"
+    ( not $not_blank )
+      and
+    length( my $class = ref $e )
+  ) {
+    carp_unique( sprintf(
+      "Objects of external exception class '%s' stringify to '' (the "
+    . 'empty string), implementing the so called null-object-pattern. '
+    . 'Given Perl\'s "globally cooperative" exception handling using this '
+    . 'class of exceptions is extremely dangerous, as it may (and often '
+    . 'does) result in silent discarding of errors. DBIx::Class tries to '
+    . 'work around this as much as possible, but other parts of your '
+    . 'software stack may not be even aware of the problem. Please submit '
+    . 'a bugreport against the distribution containing %s.',
+
+      ($class) x 2,
+    ));
+
+    $not_blank = 1;
+  }
 
   return $not_blank;
 }

t/33exception_wrap.t

@@ -3,6 +3,7 @@ use warnings;
 
 use Test::More;
 use Test::Exception;
+use Test::Warn;
 
 use lib qw(t/lib);
 
@@ -23,4 +24,20 @@ is_deeply (
   'Exception-arrayref contents preserved',
 );
 
+for my $ap (qw(
+  DBICTest::AntiPattern::TrueZeroLen
+  DBICTest::AntiPattern::NullObject
+)) {
+  eval "require $ap";
+
+  warnings_like {
+    eval {
+      $schema->txn_do (sub { die $ap->new });
+    };
+
+    isa_ok $@, $ap;
+  } qr/\QObjects of external exception class '$ap' stringify to '' (the empty string)/,
+    'Proper warning on encountered antipattern';
+}
+
 done_testing;

t/34exception_action.t

@@ -28,8 +28,18 @@ throws_ok { $e->rethrow }
 isa_ok( $@, 'DBIx::Class::Exception' );
 
 # Now lets rethrow via exception_action
-$schema->exception_action(sub { die @_ });
-throws_ok \&$throw, $ex_regex;
+{
+  my $handler_execution_counter = 0;
+
+  $schema->exception_action(sub {
+    $handler_execution_counter++;
+    like $_[0], $ex_regex, "Exception is precisely passed to exception_action";
+    die @_
+  });
+
+  throws_ok \&$throw, $ex_regex;
+  is $handler_execution_counter, 1, "exception_action handler executed exactly once";
+}
 
 #
 # This should have never worked!!!
@@ -80,4 +90,30 @@ throws_ok \&$throw,
 throws_ok { $schema->storage->throw_exception('floob') }
   qr/DBICTest::Exception is handling this: floob/;
 
+# test antipatterns
+for my $ap (qw(
+  DBICTest::AntiPattern::TrueZeroLen
+  DBICTest::AntiPattern::NullObject
+)) {
+  eval "require $ap";
+  my $exp_warn = qr/\QObjects of external exception class '$ap' stringify to '' (the empty string)/;
+
+  # make sure an exception_action can replace $@ with an antipattern
+  $schema->exception_action(sub { die $ap->new });
+  warnings_like {
+    eval { $throw->() };
+    isa_ok $@, $ap;
+  } $exp_warn, 'proper warning on antipattern encountered within exception_action';
+
+  # and make sure that the retrhow works
+  $schema->exception_action(sub { die @_ });
+  warnings_like {
+    eval {
+      $schema->txn_do (sub { die $ap->new });
+    };
+
+    isa_ok $@, $ap;
+  } $exp_warn, 'Proper warning on encountered antipattern';
+}
+
 done_testing;

t/lib/DBICTest/AntiPattern/NullObject.pm

@@ -0,0 +1,16 @@
+package DBICTest::AntiPattern::NullObject;
+
+use warnings;
+use strict;
+
+use overload
+  'bool'   => sub { 0 },
+  '""'     => sub { '' },
+  '0+'     => sub { 0 },
+  fallback => 1
+;
+
+our $null = bless {}, __PACKAGE__;
+sub AUTOLOAD { $null }
+
+1;

t/lib/DBICTest/AntiPattern/TrueZeroLen.pm

@@ -0,0 +1,14 @@
+package DBICTest::AntiPattern::TrueZeroLen;
+
+use warnings;
+use strict;
+
+use overload
+  'bool'   => sub { 1 },
+  '""'     => sub { '' },
+  fallback => 1
+;
+
+sub new { bless {}, shift }
+
+1;

t/storage/txn.t

@@ -453,6 +453,17 @@ warnings_are {
   } qr/\QTransaction aborted: $broken_exception. Rollback failed: lost connection to storage at @{[__FILE__]} line $ln\E\n/;  # FIXME wtf - ...\E$/m doesn't work here
 
   is @w, 1, 'One matching warning only';
+
+  # try the same broken exception object, but have exception_action inject it
+  $s->exception_action(sub { die $broken_exception });
+  eval {
+    $s->txn_do( sub {
+      die "some string masked away";
+    });
+  };
+  isa_ok $@, 'DBICTest::BrokenOverload', 'Deficient exception properly propagated';
+
+  is @w, 2, 'The warning was emitted a second time';
 }
 
 done_testing;