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
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;
}
# 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) {
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;
# 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 '') ? \$@ : $@
);
}
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})
)
);
}
}
-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;
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) = @_;
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;
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";
}
projects / dbsrgits/DBIx-Class.git / commitdiff