From: Konstantin A. Pustovalov Date: Mon, 21 Jan 2013 20:40:58 +0000 (+0400) Subject: Ensure the stack properly deals and warns on Null-Pattern exception objects X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=84e4e006;p=dbsrgits%2FDBIx-Class-Historic.git Ensure the stack properly deals and warns on Null-Pattern exception objects Reuse the existing is_exception() utility to catch any and all instances of objects stringifying to "" before passing them onwards --- diff --git a/Changes b/Changes index e4b1733..c1e5aa1 100644 --- a/Changes +++ b/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 diff --git a/lib/DBIx/Class/_Util.pm b/lib/DBIx/Class/_Util.pm index 8d25ec0..2d2de30 100644 --- a/lib/DBIx/Class/_Util.pm +++ b/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; } diff --git a/t/33exception_wrap.t b/t/33exception_wrap.t index fdee230..40a7ea0 100644 --- a/t/33exception_wrap.t +++ b/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; diff --git a/t/34exception_action.t b/t/34exception_action.t index b81e568..b35c7dc 100644 --- a/t/34exception_action.t +++ b/t/34exception_action.t @@ -90,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; diff --git a/t/lib/DBICTest/AntiPattern/NullObject.pm b/t/lib/DBICTest/AntiPattern/NullObject.pm new file mode 100644 index 0000000..dc99c96 --- /dev/null +++ b/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; diff --git a/t/lib/DBICTest/AntiPattern/TrueZeroLen.pm b/t/lib/DBICTest/AntiPattern/TrueZeroLen.pm new file mode 100644 index 0000000..aa7190a --- /dev/null +++ b/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;