From: Peter Rabbitson Date: Thu, 23 Jan 2014 10:05:30 +0000 (+0100) Subject: Improve error reporting when we encounter broken exception objects X-Git-Tag: v0.08260~21 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits%2FDBIx-Class.git;a=commitdiff_plain;h=841efcb3f89a643bd283ccbbf5e73b98c4a6924a Improve error reporting when we encounter broken exception objects Undo parts of 935ea660e (which inadevrtently broke 153a6b38), while keeping the entire shebang running after issuing a stern warning. --- diff --git a/Changes b/Changes index cc470b6..01a926d 100644 --- a/Changes +++ b/Changes @@ -18,6 +18,8 @@ Revision history for DBIx::Class order_by specification and distinct and/or complex prefetch - Fix unbound growth of a resultset during repeated execute/exhaust cycles (GHPR#29) + - Work around (and be very vocal about the fact) when DBIC encounters + an exception object with broken string overloading - Clarify ambiguous behavior of distinct when used with ResultSetColumn i.e. $rs->search({}, { distinct => 1 })->get_column (...) - Setting quote_names propagates to SQL::Translator when producing diff --git a/lib/DBIx/Class/Storage/BlockRunner.pm b/lib/DBIx/Class/Storage/BlockRunner.pm index 05fe475..352c76c 100644 --- a/lib/DBIx/Class/Storage/BlockRunner.pm +++ b/lib/DBIx/Class/Storage/BlockRunner.pm @@ -5,6 +5,7 @@ use Sub::Quote 'quote_sub'; use DBIx::Class::Exception; use DBIx::Class::Carp; use Context::Preserve 'preserve_context'; +use DBIx::Class::_Util 'is_exception'; use Scalar::Util qw(weaken blessed reftype); use Try::Tiny; use Moo; @@ -154,7 +155,7 @@ sub _run { } # something above threw an error (could be the begin, the code or the commit) - if ($run_err ne '') { + if ( is_exception $run_err ) { # attempt a rollback if we did begin in the first place if ($txn_begin_ok) { diff --git a/lib/DBIx/Class/Storage/TxnScopeGuard.pm b/lib/DBIx/Class/Storage/TxnScopeGuard.pm index 09a3fc5..18c99fa 100644 --- a/lib/DBIx/Class/Storage/TxnScopeGuard.pm +++ b/lib/DBIx/Class/Storage/TxnScopeGuard.pm @@ -5,6 +5,7 @@ use warnings; use Try::Tiny; use Scalar::Util qw/weaken blessed refaddr/; use DBIx::Class; +use DBIx::Class::_Util 'is_exception'; use DBIx::Class::Carp; use namespace::clean; @@ -23,9 +24,9 @@ sub new { # FIXME FRAGILE - any eval that fails but *does not* rethrow between here # and the unwind will trample over $@ and invalidate the entire mechanism # There got to be a saner way of doing this... - if (defined $@ and "$@" ne '') { + if (is_exception $@) { weaken( - $guard->{existing_exception_ref} = (ref $@ eq '') ? \$@ : $@ + $guard->{existing_exception_ref} = (ref($@) eq '') ? \$@ : $@ ); } @@ -58,14 +59,12 @@ sub DESTROY { return unless $self->{dbh}; my $exception = $@ if ( - defined $@ - and - "$@" ne '' + is_exception $@ and ( ! defined $self->{existing_exception_ref} or - refaddr( ref $@ eq '' ? \$@ : $@ ) != refaddr($self->{existing_exception_ref}) + refaddr( ref($@) eq '' ? \$@ : $@ ) != refaddr($self->{existing_exception_ref}) ) ); diff --git a/lib/DBIx/Class/_Util.pm b/lib/DBIx/Class/_Util.pm index 0afe2ea..6b8f87c 100644 --- a/lib/DBIx/Class/_Util.pm +++ b/lib/DBIx/Class/_Util.pm @@ -49,11 +49,15 @@ BEGIN { } } -use Carp; -use Scalar::Util qw(refaddr weaken); +# FIXME - this is not supposed to be here +# Carp::Skip to the rescue soon +use DBIx::Class::Carp '^DBIx::Class|^DBICTest'; + +use Carp 'croak'; +use Scalar::Util qw(refaddr weaken blessed reftype); use base 'Exporter'; -our @EXPORT_OK = qw(sigwarn_silencer modver_gt_or_eq fail_on_internal_wantarray refcount); +our @EXPORT_OK = qw(sigwarn_silencer modver_gt_or_eq fail_on_internal_wantarray refcount is_exception); sub sigwarn_silencer { my $pattern = shift; @@ -74,6 +78,54 @@ sub refcount { B::svref_2object($_[0])->REFCNT; } +sub is_exception ($) { + my $e = $_[0]; + + my ($not_blank, $suberror); + { + local $@; + eval { + $not_blank = ($e ne '') ? 1 : 0; + 1; + } or $suberror = $@; + } + + if (defined $suberror) { + if (length (my $class = blessed($e) )) { + carp_unique( sprintf( + 'External exception object %s=%s(0x%x) implements partial (broken) ' + . 'overloading preventing it from being used in simple ($x eq $y) ' + . 'comparisons. Given Perl\'s "globally cooperative" exception ' + . 'handling this type of brokenness is extremely dangerous on ' + . 'exception objects, as it may (and often does) result in silent ' + . '"exception substitution". DBIx::Class tries to work around this ' + . 'as much as possible, but other parts of your software stack may ' + . 'not be even aware of this. Please submit a bugreport against the ' + . 'distribution containing %s and in the meantime apply a fix similar ' + . 'to the one shown at %s, in order to ensure your exception handling ' + . 'is saner application-wide. What follows is the actual error text ' + . "as generated by Perl itself:\n\n%s\n ", + $class, + reftype $e, + refaddr $e, + $class, + 'http://v.gd/DBIC_overload_tempfix/', + $suberror, + )); + + # workaround, keeps spice flowing + $not_blank = ("$e" ne '') ? 1 : 0; + } + else { + # not blessed yet failed the 'ne'... this makes 0 sense... + # just throw further + die $suberror + } + } + + return $not_blank; +} + sub modver_gt_or_eq { my ($mod, $ver) = @_; diff --git a/t/storage/txn_scope_guard.t b/t/storage/txn_scope_guard.t index ca67c98..4deffdd 100644 --- a/t/storage/txn_scope_guard.t +++ b/t/storage/txn_scope_guard.t @@ -197,51 +197,24 @@ for my $post_poison (0,1) { require Text::Balanced; - my $great_success; - { - local $TODO = 'RT#74994 *STILL* not fixed'; - - lives_ok { - # this is what poisons $@ - Text::Balanced::extract_bracketed( '(foo', '()' ); - - my $s = DBICTest->init_schema( deploy => 0 ); - my $g = $s->txn_scope_guard; - $g->commit; - $great_success++; - } 'Text::Balanced is no longer screwing up $@'; - } - - # delete all of this when T::B dep is bumped - unless ($great_success) { - -# hacky workaround for desperate folk -# intended to be copypasted into your app - { - require Text::Balanced; - require overload; - - local $@; - - # this is what poisons $@ - Text::Balanced::extract_bracketed( '(foo', '()' ); + my @w; + local $SIG{__WARN__} = sub { + $_[0] =~ /External exception object .+? \Qimplements partial (broken) overloading/ + ? push @w, @_ + : warn @_ + }; - if ($@ and overload::Overloaded($@) and ! overload::Method($@,'fallback') ) { - my $class = ref $@; - eval "package $class; overload->import(fallback => 1);" - } - } -# end of hacky workaround + lives_ok { + # this is what poisons $@ + Text::Balanced::extract_bracketed( '(foo', '()' ); - lives_ok { - # this is what poisons $@ - Text::Balanced::extract_bracketed( '(foo', '()' ); + my $s = DBICTest::Schema->connect('dbi:SQLite::memory:'); + my $g = $s->txn_scope_guard; + $g->commit; + } 'Broken Text::Balanced is not screwing up txn_guard'; - my $s = DBICTest->init_schema( deploy => 0 ); - my $g = $s->txn_scope_guard; - $g->commit; - } 'Monkeypatched Text::Balanced is no longer screwing up $@'; - } + local $TODO = 'RT#74994 *STILL* not fixed'; + is(scalar @w, 0, 'no warnings \o/'); } done_testing; diff --git a/xt/standalone_testschema_resultclasses.t b/xt/standalone_testschema_resultclasses.t index 95acd43..7ed0381 100644 --- a/xt/standalone_testschema_resultclasses.t +++ b/xt/standalone_testschema_resultclasses.t @@ -14,7 +14,7 @@ use lib 't/lib'; my $worker = sub { my $fn = shift; - if (my @offenders = grep { $_ ne 'DBIx/Class/_Util.pm' } grep { $_ =~ /(^|\/)DBI/ } keys %INC) { + if (my @offenders = grep { $_ !~ m{DBIx/Class/(?:_Util|Carp)\.pm} } grep { $_ =~ /(^|\/)DBI/ } keys %INC) { die "Wtf - DBI* modules present in %INC: @offenders"; }