From: Peter Rabbitson Date: Tue, 26 Feb 2013 08:08:44 +0000 (+0100) Subject: Warn on signs of Moose-borkage (in case it gets to be the first new()) X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=e0de554e40cb58ae5f873784089b11b727079111;p=dbsrgits%2FDBIx-Class-Historic.git Warn on signs of Moose-borkage (in case it gets to be the first new()) --- diff --git a/Changes b/Changes index 5283890..4550819 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,9 @@ Revision history for DBIx::Class + * New Features / Changes + - Debugging aid - warn on invalid result objects created by what + seems like an invalid inheritance hierarchy + * Fixes - Fix another embarrassing regression preventing correct refining of the search criteria on a prefetched relation (broken in 0.08205) diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm index b5397b6..60d0d92 100644 --- a/lib/DBIx/Class/ResultSet.pm +++ b/lib/DBIx/Class/ResultSet.pm @@ -5,7 +5,7 @@ use warnings; use base qw/DBIx::Class/; use DBIx::Class::Carp; use DBIx::Class::ResultSetColumn; -use Scalar::Util qw/blessed weaken/; +use Scalar::Util qw/blessed weaken reftype/; use Try::Tiny; use Data::Compare (); # no imports!!! guard against insane architecture @@ -2324,15 +2324,29 @@ sub new_result { my ($merged_cond, $cols_from_relations) = $self->_merge_with_rscond($values); - my %new = ( + my $new = $self->result_class->new({ %$merged_cond, - @$cols_from_relations + ( @$cols_from_relations ? (-cols_from_relations => $cols_from_relations) - : (), + : () + ), -result_source => $self->result_source, # DO NOT REMOVE THIS, REQUIRED - ); + }); + + if ( + reftype($new) eq 'HASH' + and + ! keys %$new + and + blessed($new) + ) { + carp_unique (sprintf ( + "%s->new returned a blessed empty hashref - a strong indicator something is wrong with its inheritance chain", + $self->result_class, + )); + } - return $self->result_class->new(\%new); + $new; } # _merge_with_rscond