From: Brendan Byrd Date: Mon, 10 Dec 2012 17:41:23 +0000 (-0500) Subject: Support for $val === [ {}, $val ] in literal SQL + bind specs X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=1b5ddf23;p=dbsrgits%2FDBIx-Class-Historic.git Support for $val === [ {}, $val ] in literal SQL + bind specs This wraps up the changes started in 0e773352. Now DBIC bind values can be specified just like the ones for SQL::Abstract as long as no bind metadata (e.g. datatypes) is needed Also added an explicit check to catch when a non-scalar non-stringifiable value is passed without a bind type metadata --- diff --git a/Changes b/Changes index e0f59a3..7709d3a 100644 --- a/Changes +++ b/Changes @@ -21,6 +21,9 @@ Revision history for DBIx::Class distinct => 1 (the distinct should apply to the main source only) - Massively optimize codepath around ->cursor(), over 10x speedup on some iterating workloads. + - Support standalone \[ $sql, $value ] in literal SQL with bind + specifications: \[ '? + ?', 42, 69 ] is now equivalent to + \[ '? + ?', [ {} => 42 ], [ {} => 69 ] ] - Changing the result_class of a ResultSet in progress is now explicitly forbidden. The behavior was undefined before, and would result in wildly differing outcomes depending on $rs diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm index d02d6ff..9acc4da 100644 --- a/lib/DBIx/Class/ResultSet.pm +++ b/lib/DBIx/Class/ResultSet.pm @@ -4650,6 +4650,7 @@ supported: [ $name => $val ] === [ { dbic_colname => $name }, $val ] [ \$dt => $val ] === [ { sqlt_datatype => $dt }, $val ] [ undef, $val ] === [ {}, $val ] + $val === [ {}, $val ] =head1 AUTHOR AND CONTRIBUTORS diff --git a/lib/DBIx/Class/SQLMaker.pm b/lib/DBIx/Class/SQLMaker.pm index cac1db0..14fbb29 100644 --- a/lib/DBIx/Class/SQLMaker.pm +++ b/lib/DBIx/Class/SQLMaker.pm @@ -85,6 +85,10 @@ BEGIN { # as the value to abuse with MSSQL ordered subqueries) sub __max_int () { 0x7FFFFFFF }; +# we ne longer need to check this - DBIC has ways of dealing with it +# specifically ::Storage::DBI::_resolve_bindattrs() +sub _assert_bindval_matches_bindtype () { 1 }; + # poor man's de-qualifier sub _quote { $_[0]->next::method( ( $_[0]{_dequalify_idents} and ! ref $_[1] ) diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm index 71880a5..b42fb7f 100644 --- a/lib/DBIx/Class/Storage/DBI.pm +++ b/lib/DBIx/Class/Storage/DBI.pm @@ -1573,14 +1573,25 @@ sub _gen_sql_bind { $colinfos = $ident->columns_info; } - my ($sql, @bind) = $self->sql_maker->$op( ($from || $ident), @$args ); + my ($sql, $bind); + ($sql, @$bind) = $self->sql_maker->$op( ($from || $ident), @$args ); + + $bind = $self->_resolve_bindattrs( + $ident, [ @{$args->[2]{bind}||[]}, @$bind ], $colinfos + ); if ( ! $ENV{DBIC_DT_SEARCH_OK} and $op eq 'select' and - first { blessed($_->[1]) && $_->[1]->isa('DateTime') } @bind + first { + length ref $_->[1] + and + blessed($_->[1]) + and + $_->[1]->isa('DateTime') + } @$bind ) { carp_unique 'DateTime objects passed to search() are not supported ' . 'properly (InflateColumn::DateTime formats and settings are not ' @@ -1589,9 +1600,7 @@ sub _gen_sql_bind { . 'set $ENV{DBIC_DT_SEARCH_OK} to true' } - return( $sql, $self->_resolve_bindattrs( - $ident, [ @{$args->[2]{bind}||[]}, @bind ], $colinfos - )); + return( $sql, $bind ); } sub _resolve_bindattrs { @@ -1620,24 +1629,42 @@ sub _resolve_bindattrs { }; return [ map { - if (ref $_ ne 'ARRAY') { - [{}, $_] - } - elsif (! defined $_->[0]) { - [{}, $_->[1]] - } - elsif (ref $_->[0] eq 'HASH') { - [ - ($_->[0]{dbd_attrs} or $_->[0]{sqlt_datatype}) ? $_->[0] : $resolve_bindinfo->($_->[0]), - $_->[1] - ] - } - elsif (ref $_->[0] eq 'SCALAR') { - [ { sqlt_datatype => ${$_->[0]} }, $_->[1] ] - } - else { - [ $resolve_bindinfo->({ dbic_colname => $_->[0] }), $_->[1] ] + my $resolved = + ( ref $_ ne 'ARRAY' or @$_ != 2 ) ? [ {}, $_ ] + : ( ! defined $_->[0] ) ? [ {}, $_->[1] ] + : (ref $_->[0] eq 'HASH') ? [ (exists $_->[0]{dbd_attrs} or $_->[0]{sqlt_datatype}) + ? $_->[0] + : $resolve_bindinfo->($_->[0]) + , $_->[1] ] + : (ref $_->[0] eq 'SCALAR') ? [ { sqlt_datatype => ${$_->[0]} }, $_->[1] ] + : [ $resolve_bindinfo->( + { dbic_colname => $_->[0] } + ), $_->[1] ] + ; + + if ( + ! exists $resolved->[0]{dbd_attrs} + and + ! $resolved->[0]{sqlt_datatype} + and + length ref $resolved->[1] + and + ! overload::Method($resolved->[1], '""') + ) { + require Data::Dumper; + local $Data::Dumper::Maxdepth = 1; + local $Data::Dumper::Terse = 1; + local $Data::Dumper::Useqq = 1; + local $Data::Dumper::Indent = 0; + local $Data::Dumper::Pad = ' '; + $self->throw_exception( + 'You must supply a datatype/bindtype (see DBIx::Class::ResultSet/DBIC BIND VALUES) ' + . 'for non-scalar value '. Data::Dumper::Dumper ($resolved->[1]) + ); } + + $resolved; + } @$bind ]; } diff --git a/t/sqlmaker/bind_transport.t b/t/sqlmaker/bind_transport.t index cd93245..bafe8e9 100644 --- a/t/sqlmaker/bind_transport.t +++ b/t/sqlmaker/bind_transport.t @@ -1,6 +1,9 @@ use strict; use warnings; + use Test::More; +use Test::Exception; +use Math::BigInt; use lib qw(t/lib); use DBICTest; @@ -63,4 +66,105 @@ for (1,2) { # see if we get anything back at all isa_ok ($complex_rs->next, 'DBIx::Class::Row'); +# Make sure that the bind shorthand syntax translation is accurate (and doesn't error) +shorthand_check( + [ _sub => 2 ], + [ { dbic_colname => '_sub' } => 2 ], + '[ $name => $val ] === [ { dbic_colname => $name }, $val ]', +); +shorthand_check( + [ artist => 2 ], + [ { dbic_colname => 'artist', sqlt_datatype => 'integer' } => 2 ], + 'resolution of known column during [ $name => $val ] === [ { dbic_colname => $name }, $val ]', +); +shorthand_check( + [ \ 'number' => 2 ], + [ { sqlt_datatype => 'number' } => 2 ], + '[ \$dt => $val ] === [ { sqlt_datatype => $dt }, $val ]', +); +shorthand_check( + [ {} => 2 ], + [ {} => 2 ], + '[ {} => $val ] === [ {}, $val ]', +); +shorthand_check( + [ undef, 2 ], + [ {} => 2 ], + '[ undef, $val ] === [ {}, $val ]', +); +shorthand_check( + 2, + [ {} => 2 ], + '$val === [ {}, $val ]', +); + +shorthand_check( + Math::BigInt->new(42), + [ {} => Math::BigInt->new(42) ], + 'stringifyable $object === [ {}, $object ]', +); + +throws_ok { + shorthand_check( + [ 2 ], + [], + ) +} qr !You must supply a datatype/bindtype .+ for non-scalar value \Q[ 2 ]!, + 'exception on bare array bindvalue'; + +throws_ok { + shorthand_check( + [ {} => [ 2 ] ], + [], + ) +} qr !You must supply a datatype/bindtype .+ for non-scalar value \Q[ 2 ]!, + 'exception on untyped array bindvalue'; + +throws_ok { + shorthand_check( + [ {}, 2, 3 ], + [], + ) +} qr !You must supply a datatype/bindtype .+ for non-scalar value \[ 'HASH\(\w+\)', 2, 3 \]!, + 'exception on bare multielement array bindvalue'; + +throws_ok { + shorthand_check( + bless( {}, 'Foo'), + [], + ) +} qr !You must supply a datatype/bindtype .+ for non-scalar value \Qbless( {}, 'Foo' )!, + 'exception on bare object'; + +throws_ok { + shorthand_check( + [ {}, bless( {}, 'Foo') ], + [], + ) +} qr !You must supply a datatype/bindtype .+ for non-scalar value \Qbless( {}, 'Foo' )!, + 'exception on untyped object'; + + +sub shorthand_check { + my ($bind_shorthand, $bind_expected, $testname) = @_; + + local $Test::Builder::Level = $Test::Builder::Level + 1; + + is_same_sql_bind ( + $schema->resultset('CD')->search({}, { + columns => [qw(cdid artist)], + group_by => ['cdid', \[ 'artist - ?', $bind_shorthand ] ], + })->as_query, + '( + SELECT me.cdid, me.artist + FROM cd me + GROUP BY cdid, artist - ? + )', + [ $bind_expected ], + $testname||(), + ); +} + +undef $schema; + done_testing; diff --git a/t/sqlmaker/limit_dialects/torture.t b/t/sqlmaker/limit_dialects/torture.t index 517444b..f4e7d1d 100644 --- a/t/sqlmaker/limit_dialects/torture.t +++ b/t/sqlmaker/limit_dialects/torture.t @@ -3,6 +3,7 @@ use warnings; use Test::More; use Test::Exception; +use Storable 'dclone'; use lib qw(t/lib); use DBICTest; use DBIC::SqlMakerTest; @@ -10,23 +11,26 @@ use DBIC::SqlMakerTest; my $schema = DBICTest->init_schema; my $native_limit_dialect = $schema->storage->sql_maker->{limit_dialect}; -my $attr = {}; my @where_bind = ( - [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'source' } => 'Study' ], - [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'me.title' } => 'kama sutra' ], + [ {} => 'Study' ], + [ {} => 'kama sutra' ], [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'source' } => 'Library' ], ); my @select_bind = ( - [ $attr => 11 ], [ $attr => 12 ], [ $attr => 13 ], + [ { sqlt_datatype => 'numeric' } => 11 ], + [ {} => 12 ], + [ { sqlt_datatype => 'integer', dbic_colname => 'me.id' } => 13 ], ); my @group_bind = ( - [ $attr => 21 ], + [ {} => 21 ], ); my @having_bind = ( - [ $attr => 31 ], + [ {} => 31 ], ); my @order_bind = ( - [ $attr => 1 ], [ $attr => 2 ], [ $attr => 3 ], + [ { sqlt_datatype => 'int' } => 1 ], + [ { sqlt_datatype => 'varchar', dbic_colname => 'name', sqlt_size => 100 } => 2 ], + [ {} => 3 ], ); my $tests = { @@ -563,7 +567,7 @@ my $tests = { @where_bind, @group_bind, @having_bind, - (map { [ @$_ ] } @order_bind), # without this is_deeply throws a fit + @{ dclone \@order_bind }, # without this is_deeply throws a fit ], ], limit_offset_prefetch => [ @@ -671,7 +675,7 @@ my $tests = { @where_bind, @group_bind, @having_bind, - (map { [ @$_ ] } @order_bind), # without this is_deeply throws a fit + @{ dclone \@order_bind }, # without this is_deeply throws a fit ], ], limit_offset_prefetch => [ @@ -834,14 +838,19 @@ for my $limtype (sort keys %$tests) { my $can_run = ($limtype eq $native_limit_dialect or $limtype eq 'GenericSubQ'); # chained search is necessary to exercise the recursive {where} parser - my $rs = $schema->resultset('BooksInLibrary')->search({ 'me.title' => { '=' => 'kama sutra' } })->search({ source => { '!=', 'Study' } }, { - columns => [ { identifier => 'me.id' }, 'owner.id', 'owner.name' ], # people actually do that. BLEH!!! :) - join => 'owner', # single-rel manual prefetch - rows => 4, - '+columns' => { bar => \['? * ?', [ $attr => 11 ], [ $attr => 12 ]], baz => \[ '?', [ $attr => 13 ]] }, - group_by => \[ '(me.id / ?), owner.id', [ $attr => 21 ] ], - having => \[ '?', [ $attr => 31 ] ], - }); + my $rs = $schema->resultset('BooksInLibrary')->search( + { 'me.title' => { '=' => \[ '?', 'kama sutra' ] } } + )->search( + { source => { '!=', \[ '?', [ {} => 'Study' ] ] } }, + { + columns => [ { identifier => 'me.id' }, 'owner.id', 'owner.name' ], # people actually do that. BLEH!!! :) + join => 'owner', # single-rel manual prefetch + rows => 4, + '+columns' => { bar => \['? * ?', [ \ 'numeric' => 11 ], 12 ], baz => \[ '?', [ 'me.id' => 13 ] ] }, + group_by => \[ '(me.id / ?), owner.id', 21 ], + having => \[ '?', 31 ], + } + ); # # not all tests run on all dialects (somewhere impossible, somewhere makes no sense) @@ -849,59 +858,67 @@ for my $limtype (sort keys %$tests) { # only limit, no offset, no order if ($tests->{$limtype}{limit}) { - is_same_sql_bind( - $rs->as_query, - @{$tests->{$limtype}{limit}}, - "$limtype: Unordered limit with select/group/having", - ); - - lives_ok { $rs->all } "Grouped limit runs under $limtype" - if $can_run; + lives_ok { + is_same_sql_bind( + $rs->as_query, + @{$tests->{$limtype}{limit}}, + "$limtype: Unordered limit with select/group/having", + ); + + $rs->all if $can_run; + } "Grouped limit under $limtype"; } # limit + offset, no order if ($tests->{$limtype}{limit_offset}) { - my $subrs = $rs->search({}, { offset => 3 }); - is_same_sql_bind( - $subrs->as_query, - @{$tests->{$limtype}{limit_offset}}, - "$limtype: Unordered limit+offset with select/group/having", - ); - - lives_ok { $subrs->all } "Grouped limit+offset runs under $limtype" - if $can_run; + + lives_ok { + my $subrs = $rs->search({}, { offset => 3 }); + + is_same_sql_bind( + $subrs->as_query, + @{$tests->{$limtype}{limit_offset}}, + "$limtype: Unordered limit+offset with select/group/having", + ); + + $subrs->all if $can_run; + } "Grouped limit+offset runs under $limtype"; } # order + limit, no offset $rs = $rs->search(undef, { order_by => ( $limtype =~ /GenericSubQ/ - ? [ { -desc => 'price' }, 'me.id', \[ 'owner.name + ?', [ {} => 'bah' ] ] ] # needs a same-table stable order to be happy - : [ \['? / ?', [ $attr => 1 ], [ $attr => 2 ]], \[ '?', [ $attr => 3 ]] ] + ? [ { -desc => 'price' }, 'me.id', \[ 'owner.name + ?', 'bah' ] ] # needs a same-table stable order to be happy + : [ \['? / ?', [ \ 'int' => 1 ], [ name => 2 ]], \[ '?', 3 ] ] ), }); if ($tests->{$limtype}{ordered_limit}) { - is_same_sql_bind( - $rs->as_query, - @{$tests->{$limtype}{ordered_limit}}, - "$limtype: Ordered limit with select/group/having", - ); - lives_ok { $rs->all } "Grouped ordered limit runs under $limtype" - if $can_run; + lives_ok { + is_same_sql_bind( + $rs->as_query, + @{$tests->{$limtype}{ordered_limit}}, + "$limtype: Ordered limit with select/group/having", + ); + + $rs->all if $can_run; + } "Grouped ordered limit runs under $limtype" } # order + limit + offset if ($tests->{$limtype}{ordered_limit_offset}) { - my $subrs = $rs->search({}, { offset => 3 }); - is_same_sql_bind( - $subrs->as_query, - @{$tests->{$limtype}{ordered_limit_offset}}, - "$limtype: Ordered limit+offset with select/group/having", - ); - - lives_ok { $subrs->all } "Grouped ordered limit+offset runs under $limtype" - if $can_run; + lives_ok { + my $subrs = $rs->search({}, { offset => 3 }); + + is_same_sql_bind( + $subrs->as_query, + @{$tests->{$limtype}{ordered_limit_offset}}, + "$limtype: Ordered limit+offset with select/group/having", + ); + + $subrs->all if $can_run; + } "Grouped ordered limit+offset runs under $limtype"; } # complex prefetch on partial-fetch root with limit @@ -912,20 +929,20 @@ for my $limtype (sort keys %$tests) { prefetch => 'books', ($limtype !~ /GenericSubQ/ ? () : ( # needs a same-table stable order to be happy - order_by => [ { -asc => 'me.name' }, \'me.id DESC' ] + order_by => [ { -asc => 'me.name' }, \ 'me.id DESC' ] )), }); - is_same_sql_bind ( - $pref_rs->as_query, - @{$tests->{$limtype}{limit_offset_prefetch}}, - "$limtype: Prefetch with limit+offset", - ) if $tests->{$limtype}{limit_offset_prefetch}; + lives_ok { + is_same_sql_bind ( + $pref_rs->as_query, + @{$tests->{$limtype}{limit_offset_prefetch}}, + "$limtype: Prefetch with limit+offset", + ) if $tests->{$limtype}{limit_offset_prefetch}; - if ($can_run) { - lives_ok { is ($pref_rs->all, 1, 'Expected count of objects on limited prefetch') } - "Complex limited prefetch runs under $limtype" - } + is ($pref_rs->all, 1, 'Expected count of objects on limited prefetch') + if $can_run; + } "Complex limited prefetch runs under $limtype"; } done_testing;