From: Peter Rabbitson Date: Thu, 17 Jul 2014 07:05:19 +0000 (+0200) Subject: Better, consistent handling of -literal/-value in the cond collapser X-Git-Tag: v0.082800~134 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=5f35ba0fbddfcfe22694f8deff22da4db4f01846;p=dbsrgits%2FDBIx-Class.git Better, consistent handling of -literal/-value in the cond collapser --- diff --git a/lib/DBIx/Class/Storage/DBIHacks.pm b/lib/DBIx/Class/Storage/DBIHacks.pm index ae04942..7d974cf 100644 --- a/lib/DBIx/Class/Storage/DBIHacks.pm +++ b/lib/DBIx/Class/Storage/DBIHacks.pm @@ -1120,25 +1120,36 @@ sub _collapse_cond_unroll_pairs { if (ref $rhs eq 'HASH' and ! keys %$rhs) { # FIXME - SQLA seems to be doing... nothing...? } + elsif (ref $rhs eq 'HASH' and keys %$rhs == 1 and exists $rhs->{-ident}) { + push @conds, { $lhs => { '=', $rhs } }; + } + elsif (ref $rhs eq 'HASH' and keys %$rhs == 1 and exists $rhs->{-value} and is_plain_value $rhs->{-value}) { + push @conds, { $lhs => $rhs->{-value} }; + } elsif (ref $rhs eq 'HASH' and keys %$rhs == 1 and exists $rhs->{'='}) { - for my $p ($self->_collapse_cond_unroll_pairs([ [ $lhs => $rhs->{'='} ] ])) { - - # extra sanity check - if (keys %$p > 1) { - require Data::Dumper::Concise; - local $Data::Dumper::Deepcopy = 1; - $self->throw_exception( - "Internal error: unexpected collapse unroll:" - . Data::Dumper::Concise::Dumper { in => { $lhs => $rhs }, out => $p } - ); - } + if( is_literal_value $rhs->{'='}) { + push @conds, { $lhs => $rhs }; + } + else { + for my $p ($self->_collapse_cond_unroll_pairs([ [ $lhs => $rhs->{'='} ] ])) { + + # extra sanity check + if (keys %$p > 1) { + require Data::Dumper::Concise; + local $Data::Dumper::Deepcopy = 1; + $self->throw_exception( + "Internal error: unexpected collapse unroll:" + . Data::Dumper::Concise::Dumper { in => { $lhs => $rhs }, out => $p } + ); + } - my ($l, $r) = %$p; + my ($l, $r) = %$p; - push @conds, ( ! length ref $r or is_plain_value($r) ) - ? { $l => $r } - : { $l => { '=' => $r } } - ; + push @conds, ( ! length ref $r or is_plain_value($r) ) + ? { $l => $r } + : { $l => { '=' => $r } } + ; + } } } elsif (ref $rhs eq 'ARRAY') { @@ -1208,23 +1219,29 @@ sub _extract_fixed_condition_columns { $vals->{$undef_marker} = $v if $consider_nulls } elsif ( - ! length ref $v - or - is_plain_value ($v) - ) { - $vals->{$v} = $v; - } - elsif ( ref $v eq 'HASH' and keys %$v == 1 - and - ref $v->{'='} - and + ) { + if (exists $v->{-value}) { + if (defined $v->{-value}) { + $vals->{$v->{-value}} = $v->{-value} + } + elsif( $consider_nulls ) { + $vals->{$undef_marker} = $v->{-value}; + } + } # do not need to check for plain values - _collapse_cond did it for us - is_literal_value($v->{'='}) + elsif(ref $v->{'='} and is_literal_value($v->{'='}) ) { + $vals->{$v->{'='}} = $v->{'='}; + } + } + elsif ( + ! length ref $v + or + is_plain_value ($v) ) { - $vals->{$v->{'='}} = $v->{'='}; + $vals->{$v} = $v; } elsif (ref $v eq 'ARRAY' and ($v->[0]||'') eq '-and') { for ( @{$v}[1..$#$v] ) { diff --git a/lib/DBIx/Class/_Util.pm b/lib/DBIx/Class/_Util.pm index a7c1b50..a77f8a3 100644 --- a/lib/DBIx/Class/_Util.pm +++ b/lib/DBIx/Class/_Util.pm @@ -172,6 +172,8 @@ sub is_literal_value ($) { ( ref $_[0] eq 'SCALAR' or + ( ref $_[0] eq 'HASH' and keys %{$_[0]} == 1 and defined $_[0]->{-ident} and ! length ref $_[0]->{-ident} ) + or ( ref $_[0] eq 'REF' and ref ${$_[0]} eq 'ARRAY' ) ) ? 1 : 0; } diff --git a/t/72pg.t b/t/72pg.t index 6e1ca7d..c02a5e3 100644 --- a/t/72pg.t +++ b/t/72pg.t @@ -7,6 +7,7 @@ use Sub::Name; use DBIx::Class::Optional::Dependencies (); use lib qw(t/lib); use DBICTest; +use DBIx::Class::_Util 'is_literal_value'; plan skip_all => 'Test needs ' . DBIx::Class::Optional::Dependencies->req_missing_for ('test_rdbms_pg') unless DBIx::Class::Optional::Dependencies->req_ok_for ('test_rdbms_pg'); @@ -291,7 +292,10 @@ for my $use_insert_returning ($test_server_supports_insert_returning { -value => [3,4] }, \[ '= ?' => [arrayfield => [3, 4]] ], ) { - local $TODO = 'No introspection of complex conditions :('; + local $TODO = 'No introspection of complex literal conditions :(' + if is_literal_value $cond; + + my $arr_rs_cond = $arr_rs->search({ arrayfield => $cond }); my $row = $arr_rs_cond->create({}); diff --git a/t/sqlmaker/dbihacks_internals.t b/t/sqlmaker/dbihacks_internals.t index 66f0148..84abaf1 100644 --- a/t/sqlmaker/dbihacks_internals.t +++ b/t/sqlmaker/dbihacks_internals.t @@ -5,7 +5,7 @@ use Test::Warn; use lib qw(t/lib); use DBICTest ':DiffSQL'; -use DBIx::Class::_Util 'UNRESOLVABLE_CONDITION'; +use DBIx::Class::_Util qw(UNRESOLVABLE_CONDITION modver_gt_or_eq); use Data::Dumper; @@ -131,6 +131,36 @@ for my $t ( sql => 'WHERE ( _macro.to LIKE ? OR _wc_macros.to LIKE ? ) AND group.is_active = ? AND me.is_active = ?', efcc_result => { 'group.is_active' => 1, 'me.is_active' => 1 }, }, + + # need fixed SQLA to correctly work with this + # + ( modver_gt_or_eq('SQL::Abstract', '1.78_01') ? { + where => { -and => [ + artistid => { -value => [1] }, + charfield => { -ident => 'foo' }, + name => { '=' => { -value => undef } }, + rank => { '=' => { -ident => 'bar' } }, + ] }, + sql => 'WHERE artistid = ? AND charfield = foo AND name IS NULL AND rank = bar', + cc_result => { + artistid => { -value => [1] }, + name => undef, + charfield => { '=', { -ident => 'foo' } }, + rank => { '=' => { -ident => 'bar' } }, + }, + efcc_result => { + artistid => [1], + charfield => { -ident => 'foo' }, + rank => { -ident => 'bar' }, + }, + efcc_n_result => { + artistid => [1], + name => undef, + charfield => { -ident => 'foo' }, + rank => { -ident => 'bar' }, + }, + } : () ), + { where => { artistid => [] }, cc_result => { artistid => [] },